vb.net ExcelHelper类(二)

接上一条内容

'end ArrayToExcel

''' <summary>

''' 将二维数组数据写入Excel文件（不分页）

''' </summary>

''' <param name="sheetIndex">工作表索引</param>

''' <param name="arr">二维数组</param>

''' <param name="top">行索引</param>

''' <param name="left">列索引</param>

Public Sub ArrayToExcel(sheetIndex As Integer, arr As String(,), top As Integer, left As Integer)

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

' 改变当前工作表

Me.workSheet = CType(Me.workBook.Sheets.get_Item(sheetIndex), Excel.Worksheet)

Dim rowCount As Integer = arr.GetLength(0)

'二维数组行数（一维长度）

Dim colCount As Integer = arr.GetLength(1)

'二维数据列数（二维长度）

range = CType(workSheet.Cells(top, left), Excel.Range)

range = range.get_Resize(rowCount, colCount)

range.Value2 = arr

End Sub

'end ArrayToExcel

''' <summary>

''' 将二维数组数据写入Excel文件（自动分页，并指定要合并的列索引）

''' </summary>

''' <param name="arr">二维数组</param>

''' <param name="rows">每个WorkSheet写入多少行数据</param>

''' <param name="top">行索引</param>

''' <param name="left">列索引</param>

''' <param name="mergeColumnIndex">数组的二维索引，相当于DataTable的列索引，索引从0开始</param>

Public Sub ArrayToExcel(arr As String(,), rows As Integer, top As Integer, left As Integer, mergeColumnIndex As Integer)

Dim rowCount As Integer = arr.GetLength(0)

'二维数组行数（一维长度）

Dim colCount As Integer = arr.GetLength(1)

'二维数据列数（二维长度）

sheetCount = Me.GetSheetCount(rowCount, rows)

'WorkSheet个数

'复制sheetCount-1个WorkSheet对象

Dim i As Integer = 1

While i < sheetCount

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

workSheet.Copy(missing, workBook.Worksheets(i))

i += 1

End While

'将二维数组数据写入Excel

Dim i As Integer = sheetCount

While i >= 1

Dim startRow As Integer = (i - 1) * rows

'记录起始行索引

Dim endRow As Integer = i * rows

'记录结束行索引

'若是最后一个WorkSheet，那么记录结束行索引为源DataTable行数

If i = sheetCount Then

endRow = rowCount

End If

'获取要写入数据的WorkSheet对象，并重命名

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

workSheet.Name = sheetPrefixName + "-" + i.ToString()

'将二维数组中的数据写入WorkSheet

Dim j As Integer = 0

While j < endRow - startRow

Dim k As Integer = 0

While k < colCount

workSheet.Cells(top + j, left + k) = arr(startRow + j, k)

k += 1

End While

j += 1

End While

'利用二维数组批量写入

Dim row As Integer = endRow - startRow

Dim ss As String(,) = New String(row, colCount) {}

Dim j As Integer = 0

While j < row

Dim k As Integer = 0

While k < colCount

ss(j, k) = arr(startRow + j, k)

k += 1

End While

j += 1

End While

range = CType(workSheet.Cells(top, left), Excel.Range)

range = range.get_Resize(row, colCount)

range.Value = ss

'合并相同行

Me.MergeRows(workSheet, left + mergeColumnIndex, top, rows)

i -= 1

End While

End Sub

'end ArrayToExcel

#End Region

#Region "WorkSheet Methods"

''' <summary>

''' 改变当前工作表

''' </summary>

''' <param name="sheetIndex">工作表索引</param>

Public Sub ChangeCurrentWorkSheet(sheetIndex As Integer)

'若指定工作表索引超出范围，则不改变当前工作表

If sheetIndex < 1 Then

Return

End If

If sheetIndex > Me.WorkSheetCount Then

Return

End If

Me.workSheet = CType(Me.workBook.Sheets.get_Item(sheetIndex), Excel.Worksheet)

End Sub

''' <summary>

''' 隐藏指定名称的工作表

''' </summary>

''' <param name="sheetName">工作表名称</param>

Public Sub HiddenWorkSheet(sheetName As String)

Try

Dim sheet As Excel.Worksheet = Nothing

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Sheets.get_Item(i), Excel.Worksheet)

If workSheet.Name = sheetName Then

sheet = workSheet

End If

i += 1

End While

If sheet IsNot Nothing Then

sheet.Visible = Excel.XlSheetVisibility.xlSheetHidden

Else

Me.KillExcelProcess()

Throw New Exception("名称为""" + sheetName + """的工作表不存在")

End If

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 隐藏指定索引的工作表

''' </summary>

''' <param name="sheetIndex"></param>

Public Sub HiddenWorkSheet(sheetIndex As Integer)

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

Try

Dim sheet As Excel.Worksheet = Nothing

sheet = CType(workBook.Sheets.get_Item(sheetIndex), Excel.Worksheet)

sheet.Visible = Excel.XlSheetVisibility.xlSheetHidden

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 在指定名称的工作表后面拷贝指定个数的该工作表的副本，并重命名

''' </summary>

''' <param name="sheetName">工作表名称</param>

''' <param name="sheetCount">工作表个数</param>

Public Sub CopyWorkSheets(sheetName As String, sheetCount As Integer)

Try

Dim sheet As Excel.Worksheet = Nothing

Dim sheetIndex As Integer = 0

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Sheets.get_Item(i), Excel.Worksheet)

If workSheet.Name = sheetName Then

sheet = workSheet

sheetIndex = workSheet.Index

End If

i += 1

End While

If sheet IsNot Nothing Then

Dim i As Integer = sheetCount

While i >= 1

sheet.Copy(Me.missing, sheet)

i -= 1

End While

'重命名

Dim i As Integer = sheetIndex

While i <= sheetIndex + sheetCount

workSheet = CType(workBook.Sheets.get_Item(i), Excel.Worksheet)

workSheet.Name = sheetName + "-" + Convert.ToString(i - sheetIndex + 1)

i += 1

End While

Else

Me.KillExcelProcess()

Throw New Exception("名称为""" + sheetName + """的工作表不存在")

End If

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 将一个工作表拷贝到另一个工作表后面，并重命名

''' </summary>

''' <param name="srcSheetIndex">拷贝源工作表索引</param>

''' <param name="aimSheetIndex">参照位置工作表索引，新工作表拷贝在该工作表后面</param>

''' <param name="newSheetName"></param>

Public Sub CopyWorkSheet(srcSheetIndex As Integer, aimSheetIndex As Integer, newSheetName As String)

If srcSheetIndex > Me.WorkSheetCount OrElse aimSheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

Try

Dim srcSheet As Excel.Worksheet = CType(workBook.Sheets.get_Item(srcSheetIndex), Excel.Worksheet)

Dim aimSheet As Excel.Worksheet = CType(workBook.Sheets.get_Item(aimSheetIndex), Excel.Worksheet)

srcSheet.Copy(Me.missing, aimSheet)

'重命名

workSheet = CType(aimSheet.[Next], Excel.Worksheet)

'获取新拷贝的工作表

workSheet.Name = newSheetName

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 根据名称删除工作表

''' </summary>

''' <param name="sheetName"></param>

Public Sub DeleteWorkSheet(sheetName As String)

Try

Dim sheet As Excel.Worksheet = Nothing

'找到名称位sheetName的工作表

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Sheets.get_Item(i), Excel.Worksheet)

If workSheet.Name = sheetName Then

sheet = workSheet

End If

i += 1

End While

If sheet IsNot Nothing Then

sheet.Delete()

Else

Me.KillExcelProcess()

Throw New Exception("名称为""" + sheetName + """的工作表不存在")

End If

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 根据索引删除工作表

''' </summary>

''' <param name="sheetIndex"></param>

Public Sub DeleteWorkSheet(sheetIndex As Integer)

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

Try

Dim sheet As Excel.Worksheet = Nothing

sheet = CType(workBook.Sheets.get_Item(sheetIndex), Excel.Worksheet)

sheet.Delete()

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

#End Region

#Region "TextBox Methods"

''' <summary>

''' 向指定文本框写入数据，对每个WorkSheet操作

''' </summary>

''' <param name="textboxName">文本框名称</param>

''' <param name="text">要写入的文本</param>

Public Sub SetTextBox(textboxName As String, text As String)

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

Try

textBox = CType(workSheet.TextBoxes(textboxName), Excel.TextBox)

textBox.Text = text

Catch

Me.KillExcelProcess()

Throw New Exception("不存在ID为""" + textboxName + """的文本框！")

End Try

i += 1

End While

End Sub

''' <summary>

''' 向指定文本框写入数据，对指定WorkSheet操作

''' </summary>

''' <param name="sheetIndex">工作表索引</param>

''' <param name="textboxName">文本框名称</param>

''' <param name="text">要写入的文本</param>

Public Sub SetTextBox(sheetIndex As Integer, textboxName As String, text As String)

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

Try

textBox = CType(workSheet.TextBoxes(textboxName), Excel.TextBox)

textBox.Text = text

Catch

Me.KillExcelProcess()

Throw New Exception("不存在ID为""" + textboxName + """的文本框！")

End Try

End Sub

''' <summary>

''' 向文本框写入数据，对每个WorkSheet操作

''' </summary>

''' <param name="ht">Hashtable的键值对保存文本框的ID和数据</param>

Public Sub SetTextBoxes(ht As Hashtable)

If ht.Count = 0 Then

Return

End If

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

For Each dic As DictionaryEntry In ht

Try

textBox = CType(workSheet.TextBoxes(dic.Key), Excel.TextBox)

textBox.Text = dic.Value.ToString()

Catch

Me.KillExcelProcess()

Throw New Exception("不存在ID为""" + dic.Key.ToString() + """的文本框！")

End Try

Next

i += 1

End While

End Sub

''' <summary>

''' 向文本框写入数据，对指定WorkSheet操作

''' </summary>

''' <param name="ht">Hashtable的键值对保存文本框的ID和数据</param>

Public Sub SetTextBoxes(sheetIndex As Integer, ht As Hashtable)

If ht.Count = 0 Then

Return

End If

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

For Each dic As DictionaryEntry In ht

Try

textBox = CType(workSheet.TextBoxes(dic.Key), Excel.TextBox)

textBox.Text = dic.Value.ToString()

Catch

Me.KillExcelProcess()

Throw New Exception("不存在ID为""" + dic.Key.ToString() + """的文本框！")

End Try

Next

End Sub

#End Region

#Region "Cell Methods"

''' <summary>

''' 向单元格写入数据，对当前WorkSheet操作

''' </summary>

''' <param name="rowIndex">行索引</param>

''' <param name="columnIndex">列索引</param>

''' <param name="text">要写入的文本值</param>

Public Sub SetCells(rowIndex As Integer, columnIndex As Integer, text As String)

Try

workSheet.Cells(rowIndex, columnIndex) = text

Catch

Me.KillExcelProcess()

Throw New Exception("向单元格[" + rowIndex + "," + columnIndex + "]写数据出错！")

End Try

End Sub

''' <summary>

''' 向单元格写入数据，对指定WorkSheet操作

''' </summary>

''' <param name="sheetIndex">工作表索引</param>

''' <param name="rowIndex">行索引</param>

''' <param name="columnIndex">列索引</param>

''' <param name="text">要写入的文本值</param>

Public Sub SetCells(sheetIndex As Integer, rowIndex As Integer, columnIndex As Integer, text As String)

Try

Me.ChangeCurrentWorkSheet(sheetIndex)

'改变当前工作表为指定工作表

workSheet.Cells(rowIndex, columnIndex) = text

Catch

Me.KillExcelProcess()

Throw New Exception("向单元格[" + rowIndex + "," + columnIndex + "]写数据出错！")

End Try

End Sub

''' <summary>

''' 向单元格写入数据，对每个WorkSheet操作

''' </summary>

''' <param name="ht">Hashtable的键值对保存单元格的位置索引（行索引和列索引用“,”隔开）和数据</param>

Public Sub SetCells(ht As Hashtable)

Dim rowIndex As Integer

Dim columnIndex As Integer

Dim position As String

If ht.Count = 0 Then

Return

End If

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

For Each dic As DictionaryEntry In ht

Try

position = dic.Key.ToString()

rowIndex = Convert.ToInt32(position.Split(","C)(0))

columnIndex = Convert.ToInt32(position.Split(","C)(1))

workSheet.Cells(rowIndex, columnIndex) = dic.Value

Catch

Me.KillExcelProcess()

Throw New Exception("向单元格[" + dic.Key + "]写数据出错！")

End Try

Next

i += 1

End While

End Sub

''' <summary>

''' 向单元格写入数据，对指定WorkSheet操作

''' </summary>

''' <param name="ht">Hashtable的键值对保存单元格的位置索引（行索引和列索引用“,”隔开）和数据</param>

Public Sub SetCells(sheetIndex As Integer, ht As Hashtable)

Dim rowIndex As Integer

Dim columnIndex As Integer

Dim position As String

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

If ht.Count = 0 Then

Return

End If

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

For Each dic As DictionaryEntry In ht

Try

position = dic.Key.ToString()

rowIndex = Convert.ToInt32(position.Split(","C)(0))

columnIndex = Convert.ToInt32(position.Split(","C)(1))

workSheet.Cells(rowIndex, columnIndex) = dic.Value

Catch

Me.KillExcelProcess()

Throw New Exception("向单元格[" + dic.Key + "]写数据出错！")

End Try

Next

End Sub

''' <summary>

''' 设置单元格为可计算的

''' </summary>

''' <remarks>

''' 如果Excel的单元格格式设置为数字，日期或者其他类型时，需要设置这些单元格的FormulaR1C1属性，

''' 否则写到这些单元格的数据将不会按照预先设定的格式显示

''' </remarks>

''' <param name="arr">保存单元格的位置索引（行索引和列索引用“,”隔开）和数据</param>

Public Sub SetCells(sheetIndex As Integer, arr As String())

Dim rowIndex As Integer

Dim columnIndex As Integer

Dim position As String

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

If arr.Length = 0 Then

Return

End If

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

Dim i As Integer = 0

While i < arr.Length

Try

position = arr(i)

rowIndex = Convert.ToInt32(position.Split(","C)(0))

columnIndex = Convert.ToInt32(position.Split(","C)(1))

Dim cell As Excel.Range = CType(workSheet.Cells(rowIndex, columnIndex), Excel.Range)

cell.FormulaR1C1 = cell.Text

Catch

Me.KillExcelProcess()

Throw New Exception(String.Format("计算单元格{0}出错！", arr(i)))

End Try

i += 1

End While

End Sub

''' <summary>

''' 向单元格写入数据，对指定WorkSheet操作

''' </summary>

''' <param name="ht">Hashtable的键值对保存单元格的位置索引（行索引和列索引用“,”隔开）和数据</param>

Public Sub SetCells(sheetName As String, ht As Hashtable)

Dim rowIndex As Integer

Dim columnIndex As Integer

Dim position As String

Dim sheet As Excel.Worksheet = Nothing

Dim sheetIndex As Integer = 0

If ht.Count = 0 Then

Return

End If

Try

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Sheets.get_Item(i), Excel.Worksheet)

If workSheet.Name = sheetName Then

sheet = workSheet

sheetIndex = workSheet.Index

End If

i += 1

End While

If sheet IsNot Nothing Then

For Each dic As DictionaryEntry In ht

Try

position = dic.Key.ToString()

rowIndex = Convert.ToInt32(position.Split(","C)(0))

columnIndex = Convert.ToInt32(position.Split(","C)(1))

sheet.Cells(rowIndex, columnIndex) = dic.Value

Catch

Me.KillExcelProcess()

Throw New Exception("向单元格[" + dic.Key + "]写数据出错！")

End Try

Next

Else

Me.KillExcelProcess()

Throw New Exception("名称为""" + sheetName + """的工作表不存在")

End If

Catch e As Exception

Me.KillExcelProcess()

Throw e

End Try

End Sub

''' <summary>

''' 合并单元格，并赋值，对每个WorkSheet操作

''' </summary>

''' <param name="beginRowIndex">开始行索引</param>

''' <param name="beginColumnIndex">开始列索引</param>

''' <param name="endRowIndex">结束行索引</param>

''' <param name="endColumnIndex">结束列索引</param>

''' <param name="text">合并后Range的值</param>

Public Sub MergeCells(beginRowIndex As Integer, beginColumnIndex As Integer, endRowIndex As Integer, endColumnIndex As Integer, text As String)

Dim i As Integer = 1

While i <= Me.WorkSheetCount

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

range = workSheet.get_Range(workSheet.Cells(beginRowIndex, beginColumnIndex), workSheet.Cells(endRowIndex, endColumnIndex))

range.ClearContents()

'先把Range内容清除，合并才不会出错

range.MergeCells = True

range.Value = text

range.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

range.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

i += 1

End While

End Sub

''' <summary>

''' 合并单元格，并赋值，对指定WorkSheet操作

''' </summary>

''' <param name="sheetIndex">WorkSheet索引</param>

''' <param name="beginRowIndex">开始行索引</param>

''' <param name="beginColumnIndex">开始列索引</param>

''' <param name="endRowIndex">结束行索引</param>

''' <param name="endColumnIndex">结束列索引</param>

''' <param name="text">合并后Range的值</param>

Public Sub MergeCells(sheetIndex As Integer, beginRowIndex As Integer, beginColumnIndex As Integer, endRowIndex As Integer, endColumnIndex As Integer, text As String)

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

range = workSheet.get_Range(workSheet.Cells(beginRowIndex, beginColumnIndex), workSheet.Cells(endRowIndex, endColumnIndex))

range.ClearContents()

'先把Range内容清除，合并才不会出错

range.MergeCells = True

range.Value = text

range.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

range.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

End Sub

#End Region

#Region "Row Methods"

''' <summary>

''' 将指定索引列的数据相同的行合并，对每个WorkSheet操作

''' </summary>

''' <param name="columnIndex">列索引</param>

''' <param name="beginRowIndex">开始行索引</param>

''' <param name="endRowIndex">结束行索引</param>

Public Sub MergeRows(columnIndex As Integer, beginRowIndex As Integer, endRowIndex As Integer)

If endRowIndex - beginRowIndex < 1 Then

Return

End If

Dim i As Integer = 1

While i <= Me.WorkSheetCount

Dim beginIndex As Integer = beginRowIndex

Dim count As Integer = 0

Dim text1 As String

Dim text2 As String

workSheet = CType(workBook.Worksheets.get_Item(i), Excel.Worksheet)

Dim j As Integer = beginRowIndex

While j <= endRowIndex

range = CType(workSheet.Cells(j, columnIndex), Excel.Range)

text1 = range.Text.ToString()

range = CType(workSheet.Cells(j + 1, columnIndex), Excel.Range)

text2 = range.Text.ToString()

If text1 = text2 Then

System.Threading.Interlocked.Increment(count)

Else

If count > 0 Then

Me.MergeCells(workSheet, beginIndex, columnIndex, beginIndex + count, columnIndex, text1)

End If

beginIndex = j + 1

'设置开始合并行索引

'计数器清0

count = 0

End If

j += 1

End While

i += 1

End While

End Sub

''' <summary>

''' 将指定索引列的数据相同的行合并，对指定WorkSheet操作

''' </summary>

''' <param name="sheetIndex">WorkSheet索引</param>

''' <param name="columnIndex">列索引</param>

''' <param name="beginRowIndex">开始行索引</param>

''' <param name="endRowIndex">结束行索引</param>

Public Sub MergeRows(sheetIndex As Integer, columnIndex As Integer, beginRowIndex As Integer, endRowIndex As Integer)

If sheetIndex > Me.WorkSheetCount Then

Me.KillExcelProcess()

Throw New Exception("索引超出范围，WorkSheet索引不能大于WorkSheet数量！")

End If

If endRowIndex - beginRowIndex < 1 Then

Return

End If

Dim beginIndex As Integer = beginRowIndex

Dim count As Integer = 0

Dim text1 As String

Dim text2 As String

workSheet = CType(workBook.Worksheets.get_Item(sheetIndex), Excel.Worksheet)

Dim j As Integer = beginRowIndex

While j <= endRowIndex

range = CType(workSheet.Cells(j, columnIndex), Excel.Range)

text1 = range.Text.ToString()

range = CType(workSheet.Cells(j + 1, columnIndex), Excel.Range)

text2 = range.Text.ToString()

If text1 = text2 Then

System.Threading.Interlocked.Increment(count)

Else

If count > 0 Then

Me.MergeCells(workSheet, beginIndex, columnIndex, beginIndex + count, columnIndex, text1)

End If

beginIndex = j + 1

'设置开始合并行索引

'计数器清0

count = 0

End If

j += 1

End While

End Sub