用VB6.0做了一个导出EXCEL的代码，有点小问题
本帖最后由 bcrun 于 2012-12-11 08:29:10 编辑 导出效果可以看代码（不要直接成生EXCEL文件的代码），在运行导出数据时如果用鼠标“点住不放”EXCEL表中下面的滚动条后导出速度明显加快，不然大数据时导出速度有点慢，请高手帮助修改一下代码，谢谢。
VB引用一下“Microsoft Excel 11.0 Object Library”
代码如下：

Private Sub Command1_Click()
Dim excelApp As Excel.Application
    Set excelApp = New Excel.Application     
　　If excelApp Is Nothing Then
       Set excelApp = CreateObject("Excel.application")
       If excelApp Is Nothing Then
          Exit Sub
       End If
    End If
    excelApp.Visible = True
    Me.MousePointer = vbHourglass
    excelApp.Workbooks.Add
    With excelApp.ActiveSheet
        Dim i As Integer, j As Integer
        For i = 1 To 200
            For j = 1 To 10
                  .Cells(i, j) = j
            Next j
            .Rows(i + 1).Select
            DoEvents
        Next i
    .Cells.EntireColumn.AutoFit
    End With
    Me.MousePointer = vbDefault
    Set excelApp = Nothing
End Sub

'引用对象库:Microsoft Excel 11.0 Object Library
Option Explicit

Dim xlExcel As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Private Sub Command1_Click()

        Dim Data(1 To 200, 1 To 10) As String
        Dim i As Long, j As Long
        
        For i = 1 To 200
            For j = 1 To 10
                Data(i, j) = j
            Next
        Next
        
        On Error GoTo Errhandler
        xlExcel.Application.Visible = True
        Me.MousePointer = vbHourglass
        xlExcel.Workbooks.Add
        xlExcel.Workbooks(1).Activate
        Set xlSheet = xlExcel.Workbooks(1).Worksheets(1) 
 
        xlSheet.Activate
        xlSheet.Columns("A:J").NumberFormatLocal = "@" '设置A-J列为文本格式。
        '或者xlSheet.Range("A:J").NumberFormatLocal = "@"
        xlSheet.Range("A1:J200 ") = Data '填充数组到区域A1到J200
        xlSheet.Columns.EntireColumn.AutoFit '列自适应
        Me.MousePointer = vbDefault
        
Errhandler:
        Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    xlBook.Close
    xlExcel.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlExcel = Nothing
End Sub