0

我正在使用 ExcelLiabrary 将多个 DataTables 导出到 Excel 文件。问题是所有数据表中的日期列都被导出为数字。DataTables 填充有从列类型为日期的 Sql Server 检索到的数据。Datagrids 也正确显示它，但在 excel 中它变成数字。

这是填充 DataTable 的代码

Dim command = New SqlCommand("getdeta", sqlConn)
command.CommandType = 
CommandType.StoredProcedure
Dim adapter = New SqlDataAdapter(command)
dt1 = New DataTable()
adapter.Fill(dt1)
dgv1.DataSource = dt1

这是将数据导出到 Excel

Dim fileName = ExportAllDialog.FileName
datasetForExport.Tables.Add(dt1)
datasetForExport.Tables.Add(dt2)
ExcelLibrary.DataSetHelper.CreateWorkbook(fileName, datasetForExport)
4

1 回答 1

1

所以这里有一些 Microsoft.Office.Interop.Excel 方法的代码：

Option Strict On
Option Explicit On

Imports System.IO
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel

Public Class ExcelBook
    Private EXL As Excel.Application
    Private Book As Excel.Workbook
    Private Sheet As Excel.Worksheet
    Private MyFileName As String

    Protected Overrides Sub Finalize()
        ' Save and close the currently loaded Excel file
        Close(True)
        ' Delete the local reference to the app BEFORE destroy
        EXL = Nothing

        MyBase.Finalize()
    End Sub

    Private Sub OpenApplication()
        If EXL IsNot Nothing Then Return

        EXL = New Excel.Application
        EXL.Visible = False
        EXL.DisplayAlerts = False
    End Sub

    Public Sub Open(Filename As String)
        Open(Filename, 1)
    End Sub

    Public Sub Open(Filename As String, SheetIndex As Object)
        OpenApplication()

        ' If another Excel file is open, close it
        Close(True)

        If File.Exists(Filename) Then
            Book = EXL.Workbooks.Open(Filename)
        Else
            Book = EXL.Workbooks.Add()
        End If

        ' Turns off warning messages when saving older files
        Book.CheckCompatibility = False

        UseSheet(SheetIndex)

        MyFileName = Filename
    End Sub

    Public Sub Close(Save As Boolean)
        If Book Is Nothing Then Return

        If File.Exists(MyFileName) Then
            Book.Close(Save)
        Else
            If Save Then Book.SaveAs(MyFileName)
            Book.Close()
        End If

        Sheet = Nothing
        Book = Nothing

        MyFileName = Nothing
    End Sub

    Public Function UseSheet(Index As Object) As Boolean
        If Book Is Nothing Then Return False

        Try
            Sheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
            Sheet.Activate()
            Return True
        Catch Ex As COMException
            Return False
        End Try
    End Function

    Public Sub AddSheet(NewName As String)
        AddSheet(NewName, Nothing)
    End Sub

    Public Sub AddSheet(NewName As String, Before As Object)
        If Book Is Nothing Then Return
        If SheetExists(NewName) Then Return

        If Before Is Nothing OrElse Not SheetExists(Before) Then
            Sheet = CType(Book.Sheets.Add(After:=Book.Sheets(Book.Sheets.Count)), Excel.Worksheet)
        Else
            Sheet = CType(Book.Sheets.Add(Before:=Book.Sheets(Before)), Excel.Worksheet)
        End If
        Sheet.Activate()
        Sheet.Name = NewName
    End Sub

    Function SheetExists(Index As Object) As Boolean
        If Book Is Nothing Then Return False

        Dim LocalSheet As Excel.Worksheet

        Try
            LocalSheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
        Catch Ex As COMException
            LocalSheet = Nothing
        End Try

        Return LocalSheet IsNot Nothing
    End Function

    Public Sub RenameSheet(NewName As String)
        If Sheet Is Nothing Then Return

        If Not String.IsNullOrEmpty(NewName) Then Sheet.Name = NewName
    End Sub

    Public Sub FormatColumns(Columns As String, NewFormat As String)
        If Sheet Is Nothing Then Return

        Dim Rng = DirectCast(Sheet.Columns(Columns), Excel.Range)
        Rng.NumberFormat = NewFormat
    End Sub

    Public Sub ImportTable(Table As DataTable)
        If Sheet Is Nothing Then Return
        If Table Is Nothing Then Return
        If Table.Columns.Count = 0 Then Return

        Dim Matrix(Table.Rows.Count, Table.Columns.Count) As Object
        Dim Col As Integer

        ' Copy the datatable to an array
        For Row As Integer = 0 To Table.Rows.Count - 1
            For Col = 0 To Table.Columns.Count - 1
                Matrix(Row, Col) = Table.Rows(Row).Item(Col)
            Next
        Next

        ' Add the column headers starting in A1
        Col = 0
        For Each Column As DataColumn In Table.Columns
            Sheet.Cells(1, Col + 1) = Column.ColumnName
            Col += 1
        Next

        ' Add the data starting in cell A2
        If Table.Rows.Count > 0 Then
            Sheet.Range(Sheet.Cells(2, 1), Sheet.Cells(Table.Rows.Count + 1, Table.Columns.Count)).Value = Matrix
        End If
    End Sub

End Class

然后你可以使用这个函数来导出你的数据集：

Private Sub ExportDataSet(DS As DataSet, Filename As String)
    Dim DT As DataTable
    Dim First As Boolean = True

    With New ExcelBook
        .Open(Filename)
        For Each DT In DS.Tables
            If First Then
                .RenameSheet(DT.TableName)
                First = False
            Else
                .AddSheet(DT.TableName)
            End If
            .ImportTable(DT)
        Next
        .UseSheet(1)
        .Close(True)
    End With
End Sub
于 2021-01-19T23:00:51.627 回答