vb 快速导出表格到Excel

vb 快速导出表格到Excel

Dim i As Integer, j As Integer
Dim NewXls As Excel.Application
Dim NewBook As Excel.Workbook
Dim NewSheet As Excel.Worksheet
Dim objRange As Object

Dim CellsData() As String

Dim StartRow
Dim StartColumn
Dim nRows As Long, nColumns As Long
'构造二维数组
nRows = Grid.Rows
nColumns = Grid.Cols
ReDim CellsData(1 To nRows, 1 To nColumns)
For i = 1 To nRows
For j = 2 To nColumns
CellsData(i, j - 1) = Grid.TextMatrix(i - 1, j - 1)
Next
Next
Set NewXls = CreateObject("Excel.Application") '创建excel应用程序,打开excel2000
Set NewBook = NewXls.Workbooks.Add '创建工作簿
Set NewSheet = NewBook.Worksheets(1) '创建工作表

'导出到Excel中
If StartRow < 1 Then StartRow = 1
If StartColumn < 1 Then StartColumn = 1
Set objRange = NewSheet.Range(NewSheet.Cells(StartRow, StartColumn), NewSheet.Cells((StartRow - 1) + nRows, (StartColumn - 1) + nColumns))
objRange.Value = CellsData
Dim strfilename
' strfilename = App.Path & "\124400_新东方医院_" & Format(Now(), "yyyymmdd") & ".xls"
strfilename = App.Path & "\124400-新东方医院-" & Format(Now(), "yyyymmdd") & ".xls"
NewBook.SaveAs strfilename '保存到指定文件
' objWorkbook.Close
' objApp.Quit '退出Excel
' Set objRange = Nothing
' Set objWorksheet = Nothing
' Set objWorkbook = Nothing
' Set objApp = Nothing

'销毁二维数组
Erase CellsData

NewXls.Visible = True
Command9.Enabled = True