我有吧datagrid转换为EXCEL的模块,顺便放上来大家看一下,有没有吧MSHFLEXGRID转换的模块写出来啊,绝对给分Public Sub RsToXls(RsSrc As ADODB.Recordset)
Dim MyXlsApp As New Excel.Application
Dim MyXlsWbk As New Excel.Workbook
Dim MyXlsSht As New Excel.Worksheet
Dim i, j, k, m, n As Integer
Set MyXlsApp = CreateObject("Excel.Application")
Set MyXlsWbk = MyXlsApp.Workbooks.Add
Set MyXlsSht = MyXlsWbk.Worksheets(1)MyXlsApp.Visible = TrueWith RsSrc
If .RecordCount = 0 Then
MsgBox "没有数据,无法导出", vbExclamation
Exit Sub
End If
.MoveFirst
j = 1
MyXlsSht.Cells(1, 1).Value = "序号"
For m = 0 To RsSrc.Fields.Count - 1
MyXlsSht.Cells(1, m + 2).Value = RsSrc.Fields(m).Name
Next
Do While Not .EOF
j = j + 1
MyXlsSht.Cells(j, 1) = j - 1
For i = 0 To RsSrc.Fields.Count - 1
MyXlsSht.Cells(j, i + 2) = .Fields(i)
Next
.MoveNext
Loop
End With
'MsgBox "数据导出完成", vbInformation
'MyXlsApp.Visible = True
Set MyXlsApp = Nothing
Set MyXlsWbk = Nothing
Set MyXlsSht = NothingEnd Sub
Dim MyXlsApp As New Excel.Application
Dim MyXlsWbk As New Excel.Workbook
Dim MyXlsSht As New Excel.Worksheet
Dim i, j, k, m, n As Integer
Set MyXlsApp = CreateObject("Excel.Application")
Set MyXlsWbk = MyXlsApp.Workbooks.Add
Set MyXlsSht = MyXlsWbk.Worksheets(1)MyXlsApp.Visible = TrueWith RsSrc
If .RecordCount = 0 Then
MsgBox "没有数据,无法导出", vbExclamation
Exit Sub
End If
.MoveFirst
j = 1
MyXlsSht.Cells(1, 1).Value = "序号"
For m = 0 To RsSrc.Fields.Count - 1
MyXlsSht.Cells(1, m + 2).Value = RsSrc.Fields(m).Name
Next
Do While Not .EOF
j = j + 1
MyXlsSht.Cells(j, 1) = j - 1
For i = 0 To RsSrc.Fields.Count - 1
MyXlsSht.Cells(j, i + 2) = .Fields(i)
Next
.MoveNext
Loop
End With
'MsgBox "数据导出完成", vbInformation
'MyXlsApp.Visible = True
Set MyXlsApp = Nothing
Set MyXlsWbk = Nothing
Set MyXlsSht = NothingEnd Sub
http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=137708
将MsFlexGrid控件中显示的内容输出到Excel表格中进行打印