把MSHFlexGrid里数据导出至Excel

如何把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 = 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

下面的代码就也能导出到EXCEL

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim i As Long, J As Long

On Error GoTo ErrorHandle

Set xlApp = CreateObject( "Excel.Application ")

Set xlBook = xlApp.Workbooks.Add

Set xlSheet = xlBook.Worksheets(1)

For i = 0 To MHFGrid.Rows - 1

For J = 0 To MHFGrid.Cols - 1

xlSheet.Cells(i + 1, J + 1).Value = MHFGrid.TextMatrix(i, J)

Next J

Next i

xlSheet.Application.Visible = True

Set xlSheet = Nothing

Set xlBook = Nothing

Set xlApp = Nothing

Exit Sub

ErrorHandle:

MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly, "运行错误"

如何将表中的数据导出到电子表格中

作者：施进兵

有很多方法都可将数据库中某个表的数据导出到电子表格中，例如通过创建Access.Application，可以利用Access本身的导出功能实现将表中的数据导出到电子表格中。但是这种方法会占用较多的系统资源，并且缺乏通用性。如果一个数据库没有导出的功能怎么办？下面的这段程序代码利用记录集实现导出的功能，这种做法的好处是显而易见的：你可以控制要导出的数据，而不用将整个表的内容都导出到电子表格中。为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。如果你有兴趣的话，对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。

首先在窗体上添加一个标签控件和一个命令按钮，然后在工程中添加对DAO引用。利用下面的程序代码就可将表中的数据导出到电子表格中。

Option Explicit

Private Sub Command1_Click()

Dim tempDB As Database

Dim i As Integer ' 循环计数器

Dim j As Integer

Dim rCount As Long ' 记录的个数

Dim xl As Object ' OLE自动化对象

Dim Sn As Recordset

Screen.MousePointer = 11

Label1.Caption = "打开数据库... "

Label1.Refresh

Set tempDB = Workspaces(0).OpenDatabase( "Nwind.mdb ")

Label1.Caption = "创建Excel对象... "

Label1.Refresh

Set xl = CreateObject( "Excel.Sheet.8 ")

Label1.Caption = "创建快照型记录集... "

Label1.Refresh

Set Sn = tempDB.OpenRecordset( "Customers ", dbOpenSnapshot)

If Sn.RecordCount > 0 Then

Label1.Caption = "将字段名添加到电子表格中"

Label1.Refresh

For i = 0 To Sn.Fields.Count - 1

xl.Worksheets(1).cells(1, i + 1).Value = Sn(i).Name

Next

Sn.MoveLast

Sn.MoveFirst

rCount = Sn.RecordCount

' 在记录中循环

i = 0

Do While Not Sn.EOF

Label1.Caption = "Record: " & Str(i + 1) & " of " & _

Str(rCount)

Label1.Refresh