VB net 创建 EXCEl

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