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(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
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