代码改变世界

VB导出数据到excel

2011-05-10 19:18  李龙江  阅读(4514)  评论(0编辑  收藏  举报
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(11), objWorksheet.Cells(Me.MSHFlexGrid1.Rows, Me.MSHFlexGrid1.Cols))
    objRange.Value 
= CellsData
    objApp.Visible 
= True
    objApp.ScreenUpdating 
= True
    
    
'销毁二维数组
    Erase CellsData
    
    
Me.SetFocus
    
MsgBox "导出完毕"
End Sub