VB导出数据到excel

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

转载于:https://www.cnblogs.com/lilongjiang/archive/2011/05/10/2042403.html