Question

如何把MSHFlexGrid里的数据导出至Excel？

用Adodc1做了查询语句，结果显示在一个MSHFlexGrid里面。现在要求做一个按钮（Command1），点击它就把MSHFlexGrid里显示的数据导出至Excel表中。就是一点这个按钮，就会自动打开Excel，然后数据就已经进去了，方便编辑和打印。

要求：代码详细，直接复制到Command1下就能用。这块我不懂，所以不要搞什么子程序调用之类的，要有子程序也给直接调用好。

直接复制代码成功后，再追加100分。把这个弄完工程就结了，再不用受罪了，哈哈！

Answer 1

On Error Resume Next
Dim irow, icol, count, i As Integer
Dim irowcount, icolcount As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim bl As Boolean
Dim key As Integer

Dim RsUserTemp As Recordset
Dim RsOrderTemp As Recordset
Dim a, b
Dim aa As String
aa = Trim(Now)

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

'If rs.RecordCount < 1 Then
'MsgBox ("Error 没有记录")
'Exit Sub
'End If
irowcount = rs.RecordCount
icolcount = 18
count = 0
rs.MoveFirst
For icol = 0 To 2
'xlSheet.Cells(1, 1).Value = "查询数据" '加标头；

Next icol
xlSheet.Cells(1, 1).Value = "时间" '加标头；
xlSheet.Cells(1, 2).Value = "2#药开度" '加标头；
xlSheet.Cells(1, 3).Value = "2#药瞬时流量" '加标头；
xlSheet.Cells(1, 4).Value = "2#药累计流量" '加标头；
xlSheet.Cells(1, 5).Value = "3#药开度"
xlSheet.Cells(1, 6).Value = "3#药瞬时流量"
xlSheet.Cells(1, 7).Value = "3#药累计流量"
xlSheet.Cells(1, 8).Value = "矿浆浓度" '加标头；
xlSheet.Cells(1, 9).Value = "矿浆流量" '加标头
xlSheet.Cells(1, 10).Value = "干矿量累计"
xlSheet.Cells(1, 11).Value = "酸1开度" '加标头；
xlSheet.Cells(1, 12).Value = "酸1瞬时流量" '加标头；
xlSheet.Cells(1, 13).Value = "酸1累计流量" '加标头
xlSheet.Cells(1, 14).Value = "酸2开度" '加标头；
xlSheet.Cells(1, 15).Value = "酸2瞬时流量" '加标头；
xlSheet.Cells(1, 16).Value = "酸2累计流量" '加标头
xlSheet.Cells(1, 17).Value = "酸3开度" '加标头；
xlSheet.Cells(1, 18).Value = "酸3瞬时流量" '加标头；
xlSheet.Cells(1, 19).Value = "酸3累计流量" '加标头
xlSheet.Cells(1, 20).Value = "酸4开度" '加标头；
xlSheet.Cells(1, 21).Value = "酸4瞬时流量" '加标头；
xlSheet.Cells(1, 22).Value = "酸4累计流量"
xlSheet.Cells(1, 23).Value = "酸5开度"
xlSheet.Cells(1, 24).Value = "酸5瞬时流量"
xlSheet.Cells(1, 25).Value = "酸5累计流量"
xlSheet.Cells(1, 26).Value = "酸6开度"
xlSheet.Cells(1, 27).Value = "酸6瞬时流量"
xlSheet.Cells(1, 28).Value = "酸6累计流量"
xlSheet.Cells(1, 29).Value = "酸总量"
Adodc1.Recordset.MoveFirst
For a = 2 To 200
b = 1

If Not Adodc1.Recordset.EOF Then
xlSheet.Cells(a, b) = Adodc1.Recordset("时间")
xlSheet.Cells(a, b + 1) = Adodc1.Recordset("2#药开度")
xlSheet.Cells(a, b + 2) = Adodc1.Recordset("2#药瞬时流量")
xlSheet.Cells(a, b + 3) = Adodc1.Recordset("2#药累计流量")
xlSheet.Cells(a, b + 4) = Adodc1.Recordset("3#药开度")
xlSheet.Cells(a, b + 5) = Adodc1.Recordset("3#药瞬时流量")
xlSheet.Cells(a, b + 6) = Adodc1.Recordset("3#药累计流量")
xlSheet.Cells(a, b + 7) = Adodc1.Recordset("矿浆浓度")
xlSheet.Cells(a, b + 8) = Adodc1.Recordset("矿浆流量")
xlSheet.Cells(a, b + 9) = Adodc1.Recordset("干矿量累计")
xlSheet.Cells(a, b + 10) = Adodc1.Recordset("酸1开度")
xlSheet.Cells(a, b + 11) = Adodc1.Recordset("酸1瞬时流量")
xlSheet.Cells(a, b + 12) = Adodc1.Recordset("酸1累计流量")
xlSheet.Cells(a, b + 13) = Adodc1.Recordset("酸2开度")
xlSheet.Cells(a, b + 14) = Adodc1.Recordset("酸2瞬时流量")
xlSheet.Cells(a, b + 15) = Adodc1.Recordset("酸2累计流量")
xlSheet.Cells(a, b + 16) = Adodc1.Recordset("酸3开度")
xlSheet.Cells(a, b + 17) = Adodc1.Recordset("酸3瞬时流量")
xlSheet.Cells(a, b + 18) = Adodc1.Recordset("酸3累计流量")
xlSheet.Cells(a, b + 19) = Adodc1.Recordset("酸4开度")
xlSheet.Cells(a, b + 20) = Adodc1.Recordset("酸4瞬时流量")
xlSheet.Cells(a, b + 21) = Adodc1.Recordset("酸4累计流量")
xlSheet.Cells(a, b + 22) = Adodc1.Recordset("酸5开度")
xlSheet.Cells(a, b + 23) = Adodc1.Recordset("酸5瞬时流量")
xlSheet.Cells(a, b + 24) = Adodc1.Recordset("酸5累计流量")
xlSheet.Cells(a, b + 25) = Adodc1.Recordset("酸6开度")
xlSheet.Cells(a, b + 26) = Adodc1.Recordset("酸6瞬时流量")
xlSheet.Cells(a, b + 27) = Adodc1.Recordset("酸6累计流量")
xlSheet.Cells(a, b + 28) = Adodc1.Recordset("酸总量")
Else
Exit For
End If
Adodc1.Recordset.Move 1
Next

rs.MoveFirst
xlSheet.Cells(2, 2).Value = Trim(Text1.Text) & Trim(Text2.Text)
For irow = 0 To irowcount - 1
Set RsUserTemp = New Recordset
RsUserTemp.CursorLocation = adUseClient
RsUserTemp.Open "select * from 状态数据 " _
& "where user0_id=" & rs!user0_id, Cn, adOpenStatic, adLockReadOnly
xlSheet.Cells(irow + 4, 1).Value = count + 1
xlSheet.Cells(irow + 4, 2).Value = RsUserTemp!user0_id
xlSheet.Cells(irow + 4, 3).Value = RsUserTemp!user0_name
xlSheet.Cells(irow + 4, 4).Value = RsUserTemp!Address
xlSheet.Cells(irow + 4, 5).Value = RsUserTemp!callno1
Set RsUserTemp = Nothing
Set RsOrderTemp = New Recordset
RsOrderTemp.CursorLocation = adUseClient
If RsOrderTemp.RecordCount = 0 Then
Else

RsOrderTemp.MoveFirst
Do While (Not RsOrderTemp.EOF)
key = 0
key = Val(Mid(str(RsOrderTemp!Order_Time), 6, 2))
Select Case key
Case 0
Exit Do
Case 1
xlSheet.Cells(irow + 4, 6).Value = RsOrderTemp!Order_Amount
Case 2
xlSheet.Cells(irow + 4, 7).Value = RsOrderTemp!Order_Amount
Case 3
xlSheet.Cells(irow + 4, 8).Value = RsOrderTemp!Order_Amount
Case 4
xlSheet.Cells(irow + 4, 9).Value = RsOrderTemp!Order_Amount
Case 5
xlSheet.Cells(irow + 4, 10).Value = RsOrderTemp!Order_Amount
Case 6
xlSheet.Cells(irow + 4, 11).Value = RsOrderTemp!Order_Amount
Case 7
xlSheet.Cells(irow + 4, 12).Value = RsOrderTemp!Order_Amount
Case 8
xlSheet.Cells(irow + 4, 13).Value = RsOrderTemp!Order_Amount
Case 9
xlSheet.Cells(irow + 4, 14).Value = RsOrderTemp!Order_Amount
Case 10
xlSheet.Cells(irow + 4, 15).Value = RsOrderTemp!Order_Amount
Case 11
xlSheet.Cells(irow + 4, 16).Value = RsOrderTemp!Order_Amount
Case 12
xlSheet.Cells(irow + 4, 17).Value = RsOrderTemp!Order_Amount
End Select
RsOrderTemp.MoveNext
Loop
End If
Set RsOrderTemp = Nothing
count = count + 1
rs.MoveNext
If bl Then '因为第一条记录还未导出所以让指针回滚；
rs.MovePrevious
End If
Next
xlApp.Visible = True
xlBook.Save
Set xlApp = Nothing

这个我也是从网上查到摘抄的.在我这能用.
我用的是ADODC+DATAGRID控件.

Answer 2

'这是我自己的程序中的一段,能导出到EXCEL模板中,进行打印,等下下我改得清楚一点再贴上来

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

以下是精简后的代码,不清楚你工作中的一些细节,所以如有问题与我讨论
Private Sub Command1_Click()

MSFlexGrid1.Redraw = False '关闭表格重画，加快运行速度
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Open(App.Path & "\对账模板.xls") '打开已经存在的EXCEL工件簿文件
xlApp.Visible = True '设置EXCEL对象可见（或不可见）
Set xlsheet = xlBook.Worksheets("Sheet1") '设置活动工作表

For R = 0 To MSFlexGrid1.Rows - 1 '行循环
For C = 0 To MSFlexGrid1.Cols - 1 '列循环
MSFlexGrid1.Row = R
MSFlexGrid1.Col = C
xlBook.Worksheets("Sheet1").Cells(R + 1, C + 1) = MSFlexGrid1.Text '保存到EXCEL
Next C
Next R

MSFlexGrid1.Redraw = True

'xlsheet.PrintOut '打印工作表

xlApp.DisplayAlerts = False '不进行安全提示

'xlBook.Close (False) '关闭工作簿

Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

End Sub

Answer 3

'MSHFlexGrid控件的导出
Public Function FlexExportE(ByVal Flex1 As MSHFlexGrid, ByVal CommonDialog1 As CommonDialog)
mvarVersion = vbLBV5
Dim SaveFilePath As String
Dim EXEString As String
Dim i As Integer, j As Integer
Dim InsertAmount As Integer
Dim WS As DAO.Workspace
Dim DB As DAO.Database
Dim TABL As DAO.TableDef
Dim RS As DAO.Recordset
'On Error GoTo err_handle
' On Error Resume Next
With CommonDialog1
.CancelError = False
.Filter = "Excel文件(*.xls)|*.xls"
.DialogTitle = "将数据导出到Excel表(5.0)"
.ShowOpen
If Trim(.FileName) = "" Then
Exit Function
End If

SaveFilePath = .FileName
End With
'If flex1.ColumnHeaders.Count <= 0 Then
' Exit Sub
'End If

Dim MyFile
MyFile = Dir(SaveFilePath)
Dim Msg As Integer
If MyFile <> "" Then
Msg = MsgBox("是否要覆盖原文件！", vbInformation + vbYesNo, "提示")
If Msg = 7 Then
Exit Function
Else
Kill (MyFile)
End If
End If

Set WS = DBEngine.CreateWorkspace("WS", "Admin", "", dbUseJet)

Dim mdbFile
mdbFile = Dir(App.Path & "\report\FlexToExcel.mdb")
If mdbFile <> "" Then
Kill App.Path & "\report\FlexToExcel.mdb"
End If
' Set DB = WS.CreateDatabase(App.Path & "\report\FlexToExcel.mdb", dbLangGeneral, dbEncrypt)
Set DB = WS.CreateDatabase(App.Path & "\report\FlexToExcel.mdb", dbLangGeneral, dbEncrypt)
Set TABL = DB.CreateTableDef("Excel")
' For i = 1 To Flex1.Cols - 1
' TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, i), dbText, 250)
' 'TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, i), dbSingle, 250)
' Next i

TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 0), dbText, 250) TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 1), dbText, 250) 'emp_id1
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 2), dbText, 250) '部门
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 3), dbText, 250) '工号
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 4), dbText, 250) '姓名
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 5), dbText, 250) '月份
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 6), dbDouble, 250) 'base
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 7), dbDouble, 250) '岗位
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 8), dbDouble, 250) '津贴
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 9), dbDouble, 250) '技能

DB.TableDefs.Append TABL
Set RS = DB.OpenRecordset("Excel")
If Flex1.Rows > 1 Then
InsertAmount = Flex1.Cols - 1
For i = 1 To Flex1.Rows - 1
RS.AddNew
'RS.Fields(0) = Flex1.ListItems.Item(i).Text
'RS.Fields(0) = Flex1.TextMatrix(i, 1)
For j = 0 To InsertAmount
If Flex1.TextMatrix(i, j) <> "" Then
RS.Fields(j) = Flex1.TextMatrix(i, j)
ElseIf Flex1.TextMatrix(i, j) = "" Then
RS.Fields(j) = "//"
End If
Next j
RS.Update
Next i
End If
EXEString = "select * into [Excel " & Format(CStr(mvarVersion), "0.0") & ";database=" & SaveFilePath & "].LBExcel from Excel"
DB.Execute EXEString
RS.Close
DB.Close
WS.Close
Kill App.Path & "\report\FlexToExcel.mdb"
MsgBox "导出数据到Excel表成功!", vbInformation, "提示"
Exit Function
err_handle:
Select Case Err
Case 53:
Resume Next
End Select
End Function

这个是我自己的，自己看下 做下改动吧

Answer 4

你点我的空间 我的介绍里有网盘地址

你找accesstoexcel或者sample 都有导出到excel的东西！~