Question

如何将Gird中所有数据导出到Excel

Answer 1

1、Grid种类很多，以下示例vb6导出MSFlexGrid表格数据到Excel表格中

    Public Sub ExportToExcel(ByRef objGrid As MSHFlexGrid, ByVal strFileName As String, Optional StartRow As Long = 1, Optional StartColumn As Long = 1)  
        Dim objApp As Object  
        Dim objWorkbook As Object  
        Dim objWorksheet As Object  
        Dim objRange As Object  
        Dim CellsData() As String  
        Dim i As Long, j As Long  
        Dim nRows As Long, nColumns As Long  
          
        '构造二维数组  
        nRows = objGrid.Rows  
        nColumns = objGrid.Cols  
        ReDim CellsData(1 To nRows, 1 To nColumns)  
        For i = 1 To nRows  
            For j = 1 To nColumns  
                CellsData(i, j) = objGrid.TextMatrix(i - 1, j - 1)  
            Next  
        Next  
          
        '导出到Excel中  
        If StartRow < 1 Then StartRow = 1  
        If StartColumn < 1 Then StartColumn = 1  
        Set objApp = CreateObject("Excel.Application")  
        objApp.ScreenUpdating = False '禁止屏幕刷新  
        Set objWorkbook = objApp.Workbooks.Add  
        Set objWorksheet = objWorkbook.Sheets.Add  
        Set objRange = objWorksheet.Range(objWorksheet.Cells(StartRow, StartColumn), objWorksheet.Cells((StartRow - 1) + nRows, (StartColumn - 1) + nColumns))  
 尘握       objRange.Value = CellsData  
        objWorkbook.SaveAs strFileName '保存到指定文件  
        objWorkbook.Close  
        objApp.Quit '退出Excel  
        Set objRange = Nothing  
        Set objWorksheet = Nothing  
        Set objWorkbook = Nothing  
        Set objApp = Nothing  
          
        '销毁二维数组  
        Erase CellsData  
    End Sub  


2、测试代码如下：

    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()  
        ExportToExcel Me.MSHFlexGrid1, "d:/temp.xls"  
          
        Me.SetFocus  
        MsgBox "导出完毕"  
    End Sub 
    
3、测试环境vb6企业版，excel2003

Answer 2

dim ExcelApp As Excel.Application
Set ExcelApp = GetObject(, "Excel.Application")
dim i as Integer
dim j as Integer
With MSHFlexGrid1 '将MSHFlexGrid1中山烂内容写岁败到EXCEL表格乎唯颤中
For i = 0 To .Rows - 1
For J = 0 To .Cols - 1
DoEvents
ExcelApp.ActiveSheet.Cells(i + 1, J + 1) = .TextMatrix(i, J)
Next J
Next i
End With