VB 导出数据到Excel

Posted 2020-07-13 xbj_hyml

Option Explicit

Private Sub Form_Load()
    Dim i As Long, j As Long
    
    Me.MSHFlexGrid1.Rows = 2000
    Me.MSHFlexGrid1.Cols = 10
    For i = 0 To Me.MSHFlexGrid1.Rows - 1
        For j = 0 To Me.MSHFlexGrid1.Cols - 1
            Me.MSHFlexGrid1.TextMatrix(i, j) = i & "行" & j & "列"
        Next
    Next
    Debug.Print Me.MSHFlexGrid1.TextArray(100)
End Sub

Private Sub cmdExport_Click()
    Dim i As Long, j As Long
    Dim CellsData() As String
    
    Dim objApp As Excel.Application
    Dim objWorkbook As Excel.Workbook
    Dim objWorksheet As Excel.Worksheet
    Dim objRange As Excel.Range
    
    ‘构造二维数组
    ReDim CellsData(1 To Me.MSHFlexGrid1.Rows, 1 To Me.MSHFlexGrid1.Cols)
    For i = 1 To Me.MSHFlexGrid1.Rows
        For j = 1 To Me.MSHFlexGrid1.Cols
            CellsData(i, j) = Me.MSHFlexGrid1.TextMatrix(i - 1, j - 1)
        Next
    Next
    
    ‘导出到Excel中
    Set objApp = New Excel.Application
    objApp.ScreenUpdating = False ‘禁止屏幕刷新
    Set objWorkbook = objApp.Workbooks.Add
    Set objWorksheet = objWorkbook.Sheets.Add
    Set objRange = objWorksheet.Range(objWorksheet.Cells(1, 1), objWorksheet.Cells(Me.MSHFlexGrid1.Rows, Me.MSHFlexGrid1.Cols))
    objRange.Value = CellsData
    objApp.Visible = True
    objApp.ScreenUpdating = True
    
    ‘销毁二维数组
    Erase CellsData
    
    Me.SetFocus
    MsgBox "导出完毕"
End Sub