如何把MSHFlexGrid里的数据导出至Excel？用Adodc1做了查询语句，结果显示在一个MSHFlexGrid里面。

现在要求做一个按钮（Command1），点击它就把MSHFlexGrid里显示的数据导出至Excel表中。

就是一点这个按钮，就会自动打开Excel，然后数据就已经进去了，方便编辑和打印。

要求：代码详细，直接复制到Command1下就能用。

这块我不懂，所以不要搞什么子程序调用之类的，要有子程序也给直接调用好。

直接复制代码成功后，再追加100分。

把这个弄完工程就结了，再不用受罪了，哈哈！以下是精简后的代码,不清楚你工作中的一些细节,所以如有问题与我讨论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 = RMSFlexGrid1.Col = CxlBook.Worksheets("Sheet1").Cells(R + 1, C + 1) = MSFlexGrid1.Text '保存到EXCEL Next CNext RMSFlexGrid1.Redraw = True'xlsheet.PrintOut '打印工作表xlApp.DisplayAlerts = False '不进行安全提示'xlBook.Close (False) '关闭工作簿Set xlsheet = NothingSet xlBook = NothingxlApp.QuitSet xlApp = NothingEnd Sub下面的代码就也能导出到EXCELDim xlApp As Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.WorksheetDim i As Long, J As LongOn Error GoTo ErrorHandleSet xlApp = CreateObject( "Excel.Application ")Set xlBook = xlApp.Workbooks.AddSet xlSheet = xlBook.Worksheets(1)For i = 0 To MHFGrid.Rows - 1For J = 0 To MHFGrid.Cols - 1xlSheet.Cells(i + 1, J + 1).Value = MHFGrid.TextMatrix(i, J)Next JNext ixlSheet.Application.Visible = TrueSet xlSheet = NothingSet xlBook = NothingSet xlApp = NothingExit SubErrorHandle:MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly, "运行错误"如何将表中的数据导出到电子表格中作者：施进兵有很多方法都可将数据库中某个表的数据导出到电子表格中，例如通过创建Access.Application，可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。

但是这种方法会占用较多的系统资源，并且缺乏通用性。

如果一个数据库没有导出的功能怎么办？下面的这段程序代码利用记录集实现导出的功能，这种做法的好处是显而易见的：你可以控制要导出的数据，而不用将整个表的内容都导出到电子表格中。

为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。

如果你有兴趣的话，对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。

首先在窗体上添加一个标签控件和一个命令按钮，然后在工程中添加对DAO引用。

利用下面的程序代码就可将表中的数据导出到电子表格中。

Option ExplicitPrivate Sub Command1_Click()Dim tempDB As DatabaseDim i As Integer ' 循环计数器Dim j As IntegerDim rCount As Long ' 记录的个数Dim xl As Object ' OLE自动化对象Dim Sn As RecordsetScreen.MousePointer = 11Label1.Caption = "打开数据库... "Label1.RefreshSet tempDB = Workspaces(0).OpenDatabase( "Nwind.mdb ")Label1.Caption = "创建Excel对象... "Label1.RefreshSet xl = CreateObject( "Excel.Sheet.8 ")Label1.Caption = "创建快照型记录集... "Label1.RefreshSet Sn = tempDB.OpenRecordset( "Customers ", dbOpenSnapshot)If Sn.RecordCount > 0 ThenLabel1.Caption = "将字段名添加到电子表格中"Label1.RefreshFor i = 0 To Sn.Fields.Count - 1xl.Worksheets(1).cells(1, i + 1).Value = Sn(i).NameNextSn.MoveLastSn.MoveFirstrCount = Sn.RecordCount' 在记录中循环i = 0Do While Not Sn.EOFLabel1.Caption = "Record: " & Str(i + 1) & " of " & _Str(rCount)Label1.Refresh' 加每个字段的值加到工作表中If Sn(j).Type < 11 Thenxl.Worksheets(1).cells(i + 2, j + 1).Value = Sn(j)Else' 处理Memo和LongBinary 类型的字段xl.Worksheets(1).cells(i + 2, j + 1).Value = "Memo or Binary Data "End IfNext jSn.MoveNexti = i + 1Loop' 保存工作表Label1.Caption = "保存文件... "Label1.Refreshxl.SaveAs "c:\Customers.XLS "'从内存中删除Excel对象Label1.Caption = "退出Excel "Label1.Refreshxl.Application.QuitElse' 没有记录End If' 清除Label1.Caption = "清除对象"Label1.RefreshSet xl = NothingSet Sn = NothingSet tempDB = NothingScreen.MousePointer = 0 ' 恢复鼠标指针Label1.Caption = "Ready "Label1.RefreshEnd SubPrivate Sub Form_Load()Label1.AutoSize = TrueLabel1.Caption = "Ready "Label1.RefreshEnd Sub给你个我用的方法，很好用'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' .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)) = "宋体"' '.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Size = 10' '标题字体加粗' '.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous ' '设表格边框样式'字体' .Range(SA) = "宋体"' .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' '对齐' .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 页"' .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[VB]将VB表格中的数据导出到Excel(2006-5-14 17:30:00)【收藏】【评论】【打印】【关闭】步骤介绍：首先在VB建一个MSFlexGrid表格，再连接到数据库，将数据库的表的资料显示到表格中，最后调用ExportExcel1（）函数将表格中数据导出到Excel.第一步：在VB建一个MSFlexGrid表格，再连接到数据库，将数据库的表的资料显示到表格中，这个代码我就不写了。