100分!高分请教:

Question

这段代码是在MSflexgrid查询结果导出到EXCEL，现在我用的是datagrid，请问代码该怎么改?
高分请教！，谢谢！
Private Sub Command1_Click()
  Dim Xlapp As Object
    Dim i As Long
    Dim j  As Long
    Dim Header As String
    Dim xlsheet As Excel.Worksheet
    Set Xlapp = CreateObject("excel.application")
    Xlapp.Workbooks.Add
    Xlapp.Visible = True
    Set xlsheet = Xlapp.Worksheets.Add
    With xlsheet
        '      .Range("C1") = Header
        '      .Range("C1").Font.Size = 20
        '      .Range("A2") = "´Ó" & DTPicker1.Value & "µ½" & DTPicker2.Value & "Ϊֹ:"
        For i = 1 To msgList.Rows - 1
            For j = 0 To msgList.Cols - 1
                .Cells(i + 1, j + 1) = msgList.TextMatrix(i, j)
            Next
        Next
    End With
    Set xlsheet = Nothing
    Set Xlapp = Nothing
End Sub

Answer 1

这里是关键
       For i = 1 To msgList.Rows - 1
            For j = 0 To msgList.Cols - 1
                .Cells(i + 1, j + 1) = msgList.TextMatrix(i, j)
            Next
        Next
datagrid似乎没有cell属性（凭印象的，基本不太用）,按row+Columns方式给msgList.TextMatrix(i, j)传值

Answer 2

datagrid 并不好用,除了可以直接录入修改数据以外,提供的属性都很少
上面的代码无法直接替换为 datagrid 的,因为 datagrid 并无 Rows 总行数这个属性如果你知道总行数,或者直接从数据集求出了总行数你可以这样替换For i = 1 To 总行数
  DataGrid1.Row=i-1
  For j = 0 To DataGrid1.Columns.Count - 1
      DataGrid1.Col=j
      .Cells(i + 1, j + 1) = DataGrid1.Text
  Next
Next

Answer 3

上面的代码无法直接替换为 datagrid 的,因为 datagrid 并无 Rows 总行数这个属性
=================================
datagrid不必另设“Rows 总行数这个属性”，因为它显示的全部都是相关联的记录集中的数据，所以只需要得到rs.recordcount就可以知道datagrid的总行数了
也因为如此，把datagrid里的数据导出到excel其实就是直接把datagrid相关联得到记录集导出到excel。

Answer 4

可是人家要求用datagrid啊
请问lsftest():那我具体该怎么改呢？
请问zlt98200():那我该怎么取出总行数呢？

Answer 5

那我具体该怎么改呢？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
可以读出rs中每条记录的各个字段值（fields）然后再写到excel中去。
不过你的数据是从哪里得来的？？？？如果是从数据库中查询得到的，那么建议借用数据库的导出（access）或dts（sql server）之类的功能，简单方便很多

Answer 6

如果你原先用msflexgrid现在用datagrid只是为了想录入数据的话
建议你用vsflexgrid这个的用法与msflexgrid一样,但增强了datagrid的一此长处.
如可以直接录入数据等..

Answer 7

datagrid只是recordset的反应，你要对datagrid导数据，只能对recordset下工夫，因为datagrid是假想，数据并不读进内容中间。Sub SaveAsExcel(ByVal objRst As ADODB.Recordset, _
    ByVal strFileName As String, _
    Optional FileFormat As XlFileFormat = xlWorkbookNormal, _
    Optional blnHeaders As Boolean = True)    Dim intRowCnt                       As Integer          ' 列之计数器。
    Dim intColCnt                       As Integer          ' 栏之计数器。    Dim objExcel                        As Excel.Application
    Dim objFld                          As Field
    Dim objWorkbook                     As Excel.Workbook
    Dim objWorksheet                    As Excel.Worksheet
        
    Dim strFileExtensionType            As String           ' 延伸檔名。    On Error GoTo SaveAsExcel_EH
        
    Screen.MousePointer = vbHourglass
    
    '------------------------------------------------
    ' A0 Excel 相关设定作业。
    '------------------------------------------------
    Set objExcel = New Excel.Application
    
    ' 不让使用者操作。
    objExcel.Interactive = False    ' 背后作业。
    If objExcel.Visible = False Then
        objExcel.Visible = True
    End If
    
    ' 窗口最大化。
    objExcel.WindowState = xlMaximized
    
    ' 设定 Wokkbook 对象。
    Set objWorkbook = objExcel.Workbooks.Add
    
    ' 设定 Worksheet 对象，指向 Sheet 1。
    Set objWorksheet = objWorkbook.Worksheets.Add
    
    '------------------------------------------------
    ' A1 Excel 表头部份相关设定作业。
    '------------------------------------------------
    If blnHeaders Then
        intColCnt = 1
        For Each objFld In objRst.Fields
            Select Case objFld.Type
                
                ' 下述数据型态则予以略过。
                Case adGUID, adLongVarBinary, adLongVarWChar
                
                Case Else
                    objWorksheet.Cells(1, intColCnt).Value = objFld.Name
                    objWorksheet.Cells(1, intColCnt).Interior.ColorIndex = 33
                    objWorksheet.Cells(1, intColCnt).Font.Bold = True
                    objWorksheet.Cells(1, intColCnt).BorderAround xlContinuous
                    intColCnt = intColCnt + 1
                    
            End Select
        Next objFld
    End If    '------------------------------------------------
    ' A2 Excel 表身部份相关设定作业。
    '------------------------------------------------
    objRst.MoveFirst
    intRowCnt = 2
    
    Do While Not objRst.EOF()
        intColCnt = 1
        For Each objFld In objRst.Fields
            Select Case objFld.Type
            
                Case adGUID, adLongVarBinary, adLongVarWChar
                    
                Case Else
                    objWorksheet.Cells(intRowCnt, intColCnt).Value = objRst.Fields(objFld.Name).Value
                    intColCnt = intColCnt + 1
                    
            End Select
        Next objFld
        objRst.MoveNext
        intRowCnt = intRowCnt + 1
    Loop    '------------------------------------------------
    ' A3 Excel 自动调整栏宽。
    '------------------------------------------------
    intColCnt = 1
    
    For Each objFld In objRst.Fields        Select Case objFld.Type
            Case adGUID, adLongVarBinary, adLongVarWChar
                
            Case Else
                objWorksheet.Columns(intColCnt).AutoFit
                intColCnt = intColCnt + 1
        End Select
    Next objFld    '------------------------------------------------
    ' B1 取得延伸檔名。
    '    参阅 Excel 说明里的「Microsoft Excel 提供的档案格式转换器」
    '------------------------------------------------
    Select Case FileFormat
        Case xlSYLK
            strFileExtensionType = "slk"
        Case xlWKS
            strFileExtensionType = "wks"
        Case xlWK1, xlWK1ALL, xlWK1FMT
            strFileExtensionType = "wk1"
        Case xlCSV, xlCSVMac, xlCSVWindows
            strFileExtensionType = "csv"
        Case xlDBF2, xlDBF3, xlDBF4
            strFileExtensionType = "dbf"
        Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7, xlExcel9795
            strFileExtensionType = "xls"
        Case xlHtml
            strFileExtensionType = "htm"
        Case xlTextMac, xlTextWindows, xlUnicodeText, xlCurrentPlatformText
            strFileExtensionType = "txt"
        Case xlTextPrinter
            strFileExtensionType = "prn"
        Case Else
            strFileExtensionType = "dat"
    End Select    '------------------------------------------------
    ' B2 另存档案。
    '------------------------------------------------
    If InStr(1, strFileName, ".") = 0 Then
        
        ' 组合文件名称。
        strFileName = strFileName & "." & strFileExtensionType
        
        ' 另存档案。
        objWorksheet.SaveAs strFileName, FileFormat
        
    End If
    
    '------------------------------------------------
    ' Z0 结束作业。
    '------------------------------------------------
    ' 关闭 Workbook。
    objWorkbook.Close
               
    ' 结束 Excel 作业。
    objExcel.Quit
          
    ' 释放对象所占空间。
    Set objFld = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
    
ExitSub:    Screen.MousePointer = vbDefault
    
    Exit Sub
    
SaveAsExcel_EH:    ' 出现错误讯息。
    MsgBox "汇出失败，原因如下：" & vbCrLf & vbCrLf & Err.Number & ": " & Err.Description, _
           vbOKOnly + vbCritical, "汇出失败"
           
    ' 关闭 Workbook。
    objWorkbook.Close
               
    ' 结束 Excel 作业。
    objExcel.Quit
          
    ' 载出对象变量。
    Set objFld = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
    
    GoTo ExitSub
    
End Sub

Answer 8

当然你也可以参考这个办法：http://www.microsoft.com/china/community/Column/32.mspx这个方法的速度非常快，个人比较喜好。

Answer 9

Excel 是一个非常优秀的报表制作软件，用VBA可以控制其生成优秀的报表，本文通过添加查询语句的方法，即用Excel中的获取外部数据的功能将数据很快地从一个查询语句中捕获到EXCEL中，比起往每个CELL里写数据的方法提高许多倍。
在程序中引用Microsoft Excel 9.0 Object Library，将下文加入到一个模块中,窗体中调用如下ExporToExcel("select * from table")。则实现快速将数据导出到EXCEL中。
 
Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
    
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = Cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = strOpen
        .Open
    End With
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    '添加查询语句，导入EXCEL数据
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))
    
    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With
    
    xlQuery.FieldNames = True '显示字段名
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
        '设标题为黑体字
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
        '标题字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    
    With xlSheet.PageSetup
        .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称："   ' & Gsmc
        .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
        .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
        .LeftFooter = "&""楷体_GB2312,常规""&10制表人："
        .CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
        .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing
End Function注:：在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000
本程序在Windows 98/2000,VB 6 下运行通过。