Imports System.Reflection
Imports NPOI.SS.UserModel
Imports NPOI.XSSF.UserModel
Imports NPOI.HSSF.UserModel
Imports System.IO
Imports System.Windows.Forms
Public Class NopiExcel
Private workbook As IWorkbook '’工作簿
Private sheetList As List(Of ISheet) = New List(Of ISheet)() '’sheet列表
Private Shared suffixName As String = ".xls"
Public Sub New(ByVal suffixName As String)
If suffixName = ".xlsx" Then
workbook = New XSSFWorkbook()
ElseIf suffixName = ".xls" Then
workbook = New HSSFWorkbook()
End If
suffixName = suffixName
End Sub
''' <summary>
''' 共享方法，得到此计算机EXCEL表的后缀名
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function getSuffixName()
Dim version As Double = checkExcelVer()
If version = -1 Then
suffixName = ".xls"
ElseIf version >= 12 Then
suffixName = ".xlsx"
Else
suffixName = ".xls"
End If
Return suffixName
End Function
''' <summary>
''' 创建sheet表
''' </summary>
''' <param name="sheetName">sheet名</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function creatSheet(ByVal sheetName As String) As ISheet
If workbook Is Nothing Then
MsgBox("IWorkbook的实例为nothing", , "错误")
Return Nothing
End If
Dim sheet As ISheet = workbook.CreateSheet(sheetName)
sheetList.Add(sheet)
Return sheet
End Function
''' <summary>
''' 把dataTable的值写到excel
''' </summary>
''' <remarks></remarks>
Public Sub write(ByVal dataTable As DataTable, ByVal sheet As ISheet)
If sheet Is Nothing Then
MsgBox("ISheet的实例为nothing", , "错误")
Return
End If
If dataTable Is Nothing Then
MsgBox("DataTable的实例为nothing", , "错误")
Return
End If
''表头
Dim row As IRow = sheet.CreateRow(0)
For j = 0 To dataTable.Columns.Count - 1
Dim cell As ICell = row.CreateCell(j)
cell.SetCellValue(dataTable.Columns(j).ColumnName.ToString)
Next
For i = 0 To dataTable.Rows.Count - 1
row = sheet.CreateRow(i + 1)
For j = 0 To dataTable.Columns.Count - 1
Dim cell As ICell = row.CreateCell(j)
cell.SetCellValue(dataTable.Rows(i).Item(j).ToString)
Next
Next
End Sub
''' <summary>
''' 把dataTable的值写到excel
''' </summary>
''' <remarks></remarks>
Public Sub writeCadNestResultDto(ByVal dataTable As List(Of CadNestResultDto), ByVal sheet As ISheet)
If sheet Is Nothing Then
MsgBox("ISheet的实例为nothing", , "错误")
Return
End If
If dataTable Is Nothing Then
MsgBox("DataTable的实例为nothing", , "错误")
Return
End If
Dim HeadList As List(Of String) = New List(Of String)
HeadList.Add("名称")
HeadList.Add("材质")
HeadList.Add("厚度")
HeadList.Add("长")
HeadList.Add("宽")
HeadList.Add("数量")
HeadList.Add("利用率")
''表头
Dim row As IRow = sheet.CreateRow(0)
For j = 0 To HeadList.Count - 1
Dim cell As ICell = row.CreateCell(j)
cell.SetCellValue(HeadList(j).ToString)
Next
For i = 0 To dataTable.Count - 1
row = sheet.CreateRow(i + 1) '创建行
For j = 0 To HeadList.Count - 1
Dim cell As ICell = row.CreateCell(j)
If j = 0 Then
cell.SetCellValue("" + dataTable(i).code)
End If
If j = 1 Then
cell.SetCellValue(dataTable(i).materialTextureName)
End If
If j = 2 Then
cell.SetCellValue(dataTable(i).thickness)
End If
If j = 3 Then
cell.SetCellValue(dataTable(i).purchaseLength)
End If
If j = 4 Then
cell.SetCellValue(dataTable(i).purchaseWidth)
End If
If j = 5 Then
cell.SetCellValue(dataTable(i).quantity)
End If
If j = 6 Then
cell.SetCellValue(dataTable(i).displayUseRate)
End If
Next
Next
End Sub
''' <summary>
''' excel 工作簿保存
''' </summary>
''' <param name="fileAddress">保存路径</param>
''' <remarks></remarks>
Public Sub save(ByVal fileAddress As String)
''转为字节数组
Dim stream As MemoryStream = New MemoryStream()
workbook.Write(stream)
Dim buf = stream.ToArray()
Dim fs As FileStream = New FileStream(fileAddress, FileMode.Create, FileAccess.Write)
''保存为Excel文件
Using (fs)
fs.Write(buf, 0, buf.Length)
fs.Flush()
End Using
End Sub
''' <summary>
''' 检测此计算机EXCEL的版本号
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Shared Function checkExcelVer() As Double
Dim objExcelType As Type = Type.GetTypeFromProgID("Excel.Application")
Dim objApp = Activator.CreateInstance(objExcelType)
If objApp Is Nothing Then
Return 0
End If
Dim objVer = objApp.GetType().InvokeMember("Version", BindingFlags.GetProperty, Nothing, objApp, Nothing)
If objVer Is Nothing Then
Return -1
End If
Dim iVer As Double = Convert.ToDouble(objVer)
Return iVer
End Function
''' <summary>
''' 得到EXCEL版本
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
Public Function getExcelVerStr() As String
Dim s1 As String
Dim excelver As Double
excelver = checkExcelVer()
s1 = " Office "
If excelver = Nothing Then
MessageBox.Show("無法識別Excel的版本", "錯誤", MessageBoxButtons.OK, MessageBoxIcon.Information)
s1 = "無法識別 office 版本"
ElseIf (excelver >= 14) Then
s1 += "2010或以上"
ElseIf (excelver >= 12) Then
s1 += "2007"
ElseIf (excelver >= 11) Then
s1 += "2003"
ElseIf (excelver >= 10) Then
s1 += "XP"
ElseIf (excelver >= 9) Then
s1 += "2000"
ElseIf (excelver >= 8) Then
s1 += "97"
ElseIf (excelver >= 7) Then
s1 += "95"
End If
MsgBox(excelver)
Return s1
End Function
''' <summary>
''' 合并单元格
''' </summary>
''' <param name="sheet">sheet名</param>
''' <param name="colIndex">要合并的列序号</param>
''' <param name="beginRowsIndex">开始的行序号</param>
''' <param name="endRowsIndex">结束的行序号</param>
''' <returns>开始和结束行序号的-维数组的量表</returns>
''' <remarks></remarks>
Public Function mergerCell(ByVal sheet As ISheet, ByVal colIndex As Integer, ByVal beginRowsIndex As Integer, ByVal endRowsIndex As Integer) As List(Of Integer())
Dim preCellValue As String = sheet.GetRow(beginRowsIndex).Cells(colIndex).ToString
Dim beginIndex As Integer = beginRowsIndex
Dim beginEndArray As Integer(,) = Nothing
Dim beginEndList As List(Of Integer()) = New List(Of Integer())
For i = beginRowsIndex To endRowsIndex
Dim currentCellValue As String = sheet.GetRow(i).Cells(colIndex).ToString
If Not currentCellValue = preCellValue Then
If i > beginIndex + 1 Then
sheet.AddMergedRegion(New NPOI.SS.Util.CellRangeAddress(beginIndex, i - 1, colIndex, colIndex))
''***之前用数组实现的现在用List***
'Dim len0 As Integer = 0
'If beginEndArray Is Nothing Then
' len0 = 0
'Else
' len0 = beginEndArray.GetLength(0)
'End If
'Dim tempArray As Integer(,) = beginEndArray
'ReDim beginEndArray(len0, 1)
'If Not tempArray Is Nothing Then
' For index = 0 To tempArray.GetLength(0) - 1
' For j = 0 To tempArray.GetLength(1) - 1
' beginEndArray(index, j) = tempArray(index, j)
' Next
' Next
'End If
'beginEndArray(len0, 0) = beginIndex
'beginEndArray(len0, 1) = i - 1
beginEndList.Add({beginIndex, i - 1})
End If
beginIndex = i
preCellValue = currentCellValue
End If
''当遍历到表格最后一行时
If i = endRowsIndex And i > beginIndex Then
sheet.AddMergedRegion(New NPOI.SS.Util.CellRangeAddress(beginIndex, i, colIndex, colIndex))
''***之前用数组实现的现在用List***
'Dim len0 As Integer = 0
'If beginEndArray Is Nothing Then
' len0 = 0
'Else
' len0 = beginEndArray.GetLength(0)
'End If
'Dim tempArray As Integer(,) = beginEndArray
'ReDim beginEndArray(len0, 1)
'If Not tempArray Is Nothing Then
' For index = 0 To tempArray.GetLength(0) - 1
' For j = 0 To tempArray.GetLength(1) - 1
' beginEndArray(index, j) = tempArray(index, j)
' Next
' Next
'End If
'beginEndArray(len0, 0) = beginIndex
'beginEndArray(len0, 1) = i
beginEndList.Add({beginIndex, i})
End If
Next
Return beginEndList
End Function
End Class
