如何通过ExcelLibrary将日期列导出为正确格式的excel

Question

我正在使用ExcelLiabrary将多个DataTables导出到一个Excel文件。问题是所有数据表中的date列都被导出为number。DataTables由从列类型为date的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)

Answer 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

然后您可以使用此函数导出您的DataSet：

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