如何将MSFlexGrid中的多条数据全部导出到Excel中

Question

如何将MSFlexGrid中的多条数据全部导出到Excel中

Answer 1

Public Sub Export(formname As Form, flexgridname As String)
    Dim xlApp As Object 'Excel.Application
    Dim xlBook As Object  'Excel.Workbook
    Dim xlSheet As Object  'Excel.Worksheet    Screen.MousePointer = vbHourglass
    On Error GoTo Err_Proc
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    'Begin to fill data to sheet
    Dim i As Long
    Dim j As Integer
    With formname.Controls(flexgridname)
        For i = 0 To .rows - 1
            For j = 0 To .Cols - 1
                xlSheet.Cells(i + 1, j + 1).Value = "'" & .TextMatrix(i, j)
            Next j
        Next i
    End With
    xlApp.Visible = True
    Screen.MousePointer = vbDefault
    Exit Sub
Err_Proc:
    Screen.MousePointer = vbDefault
    MsgBox "请确认您的电脑已安装Excel！", vbExclamation, "提示"
    
End Sub'调用方法：
call export(me,"MSFlexGrid")

Answer 2

支持楼上
循环读取再写入worksheet对象

Answer 3

注意要保存一下
    If xlApp.ActiveWorkbook.Saved = False Then
        xlApp.ActiveWorkbook.SaveAs App.Path & "\mmm0.xls"
    End If
    xlApp.Quit
    Set xlApp= Nothing

Answer 4

给你个我用的方法，很好用
'Option Explicit
''*********************************************************
''* 名称：ExportToExcel
''* 功能：导出数据到EXCEL
''* 用法：ExporToExcel 记录集，标题
''*********************************************************
'Public Function ExportToExcel(Rs_Data As ADODB.Recordset, CenterHeader As String) As Boolean
'
'    Dim Irowcount As Integer
'    Dim Icolcount As Integer
'    Dim SA As String
'    Dim xlApp As New Excel.Application
'    Dim xlBook As Excel.Workbook
'    Dim xlSheet As Excel.Worksheet
'    Dim xlQuery As Excel.QueryTable
'On Error GoTo err
'    With Rs_Data
'        If .state = adStateOpen Then
'            .Close
'        End If
'        .ActiveConnection = DBConn
'        .CursorLocation = adUseClient
'        .CursorType = adOpenStatic
'        .LockType = adLockReadOnly
'        '.Source = strOpen
'        .Open
'    End With
'    With Rs_Data
'        '记录总数
'        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 = False
'
'    '添加查询语句，导入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
'    If CenterHeader = "开停历史纪录" Then
'       SA = "A1:H" + CStr(Irowcount + 1)
'
'    ElseIf CenterHeader = "锁闭阀运行状态" Then
'       SA = "A1:F" + CStr(Irowcount + 1)
'
'    ElseIf CenterHeader = "锁闭阀分配表" Then
'       SA = "A1:F" + CStr(Irowcount + 1)
'
'    ElseIf CenterHeader = "用户信息汇总" Then
'       SA = "A1:I" + CStr(Irowcount + 1)
'
'    ElseIf CenterHeader = "锁闭阀开停设置" Then
'       SA = "A1:H" + CStr(Irowcount + 1)
'
'    ElseIf CenterHeader = "房间信息" Then
'       SA = "A1:J" + CStr(Irowcount + 1)
'
'    End If
'    With xlSheet
'        '.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "宋体"
'        '.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Size = 10
'
'        '标题字体加粗
'        '.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
'        '设表格边框样式
'
'        '字体
'        .Range(SA).Font.Name = "宋体"
'        .Range(SA).Font.Size = 10
'        '设标题为黑体字
'        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
'
'        '列宽度
'        If CenterHeader = "开停历史纪录" Then
'            .Columns("A:A").ColumnWidth = 8.63
'            .Columns("B:B").ColumnWidth = 11.38
'            .Columns("C:C").ColumnWidth = 12.63
'            .Columns("D:D").ColumnWidth = 6.75
'            .Columns("E:E").ColumnWidth = 13.31
'            .Columns("F:F").ColumnWidth = 7
'            .Columns("G:G").ColumnWidth = 7
'            .Columns("H:H").ColumnWidth = 7.63
'        End If
'
'        '对齐
'        .Range(SA).HorizontalAlignment = xlCenter
'        .Range(SA).VerticalAlignment = xlCenter
'
'        '边框
'        .Range(SA).Borders(xlDiagonalDown).LineStyle = xlNone
'        .Range(SA).Borders(xlDiagonalUp).LineStyle = xlNone
'        With .Range(SA).Borders(xlEdgeLeft)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'        With .Range(SA).Borders(xlEdgeTop)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'        With .Range(SA).Borders(xlEdgeBottom)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'        With .Range(SA).Borders(xlEdgeRight)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'        With .Range(SA).Borders(xlInsideVertical)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'        With .Range(SA).Borders(xlInsideHorizontal)
'            .LineStyle = xlContinuous
'            .Weight = xlThin
'            .ColorIndex = xlAutomatic
'        End With
'    End With
'    '页面设置
'    With xlSheet.PageSetup
'        .LeftHeader = "" & "" & Chr(10) & "&10      单位名称："
'        .CenterHeader = "&""宋体,加粗""&16" & CenterHeader
'        .RightHeader = "&""Times New Roman,常规""&10" & "" & Chr(10) & "&""宋体,常规""打印日期&""Times New Roman,常规"":&D  "
'        .LeftFooter = ""
'        .CenterFooter = "第 &P 页，共 &N 页"
'        .RightFooter = ""
'        .PrintHeadings = False
'        .PrintGridlines = True
'        .PrintComments = xlPrintNoComments
'        '.PrintQuality = 200
'        .CenterHorizontally = False
'        .CenterVertically = False
'        .Draft = False
'        .PaperSize = xlPaperA4
'        .FirstPageNumber = xlAutomatic
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
'        .Zoom = 100
'    End With
'
'    xlApp.Application.Visible = True
'
'    '交还控制给Excel
'    Set xlApp = Nothing  '
'    Set xlBook = Nothing
'    Set xlSheet = Nothing
'    Exit Function
'err:
'   MsgBox err.Description, vbInformation, MsgTitle
'End Function