VB6.0報表導出的實現一例，將內容導出到Excel中，或者導出到Word文件中，在平時挺實用，不過代碼只測試了下，可以用，核心代碼如下:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "報表導出"
ClientHeight = 5910
ClientLeft = 60
ClientTop = 345
ClientWidth = 7410
LinkTopic = "Form1"
ScaleHeight = 5910
ScaleWidth = 7410
StartUpPosition = 3 '窗口缺省
Begin MSAdodcLib.Adodc Adodc1
Height = 570
Left = 825
Top = 6075
Width = 2025
_ExtentX = 3572
_ExtentY = 1005
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H80000000&
ForeColor = &H80000008&
Height = 1095
Left = 15
TabIndex = 1
Top = 825
Width = 7335
Begin VB.ComboBox cboFields
BackColor = &H00FFFFC0&
Height = 300
Left = 975
Style = 2 'Dropdown List
TabIndex = 4
Top = 240
Width = 3555
End
Begin VB.TextBox txtdata
BackColor = &H00FFFFC0&
Height = 300
Left = 945
TabIndex = 3
Top = 690
Width = 6165
End
Begin VB.ComboBox cboOperator
BackColor = &H00FFFFC0&
Height = 300
Left = 5325
Style = 2 'Dropdown List
TabIndex = 2
Top = 255
Width = 1725
End
Begin VB.Label Label3
Caption = "關鍵字"
ForeColor = &H00FF0000&
Height = 255
Left = 4650
TabIndex = 7
Top = 285
Width = 570
End
Begin VB.Label Label1
Caption = "字段名稱"
ForeColor = &H00FF0000&
Height = 285
Left = 150
TabIndex = 6
Top = 315
Width = 915
End
Begin VB.Label Label2
Caption = "關 鍵 字"
ForeColor = &H00FF0000&
Height = 255
Left = 135
TabIndex = 5
Top = 750
Width = 1155
End
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 855
Left = 0
TabIndex = 0
Top = 0
Width = 7410
_ExtentX = 13070
_ExtentY = 1508
ButtonWidth = 1931
ButtonHeight = 1349
Appearance = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 6
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查詢"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "導出到Word"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "導出到Excel"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "導出到HTML"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
ImageIndex = 5
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
ImageIndex = 6
EndProperty
EndProperty
Begin MSComctlLib.ImageList ImageList1
Left = 6810
Top = 150
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0CDA
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":19B4
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":268E
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":3368
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":4042
Key = ""
EndProperty
EndProperty
End
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "Form1.frx":4D1C
Height = 3885
Left = 15
TabIndex = 8
Top = 1995
Width = 7365
_ExtentX = 12991
_ExtentY = 6853
_Version = 393216
AllowUpdate = 0 'False
HeadLines = 1
RowHeight = 15
FormatLocked = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 12
BeginProperty Column00
DataField = "商品編號"
Caption = "商品編號"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "商品名稱"
Caption = "商品名稱"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "拼音碼"
Caption = "拼音碼"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "批號"
Caption = "批號"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column04
DataField = "產地"
Caption = "產地"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column05
DataField = "規格"
Caption = "規格"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column06
DataField = "包裝"
Caption = "包裝"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column07
DataField = "單位"
Caption = "單位"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column08
DataField = "進價"
Caption = "進價"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column09
DataField = "庫存"
Caption = "庫存"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column10
DataField = "盤點數量"
Caption = "盤點數量"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column11
DataField = "盤點盈虧數量"
Caption = "盤點盈虧數量"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
MarqueeStyle = 4
SizeMode = 1
BeginProperty Column00
ColumnWidth = 750.047
EndProperty
BeginProperty Column01
ColumnWidth = 1500.095
EndProperty
BeginProperty Column02
ColumnWidth = 659.906
EndProperty
BeginProperty Column03
ColumnWidth = 599.811
EndProperty
BeginProperty Column04
ColumnWidth = 599.811
EndProperty
BeginProperty Column05
ColumnWidth = 659.906
EndProperty
BeginProperty Column06
ColumnWidth = 494.929
EndProperty
BeginProperty Column07
ColumnWidth = 480.189
EndProperty
BeginProperty Column08
ColumnWidth = 585.071
EndProperty
BeginProperty Column09
ColumnWidth = 569.764
EndProperty
BeginProperty Column10
ColumnWidth = 884.976
EndProperty
BeginProperty Column11
ColumnWidth = 1154.835
EndProperty
EndProperty
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
' http://www.codesc.net
Attribute VB_Exposed = False
Option Explicit
Public tb As String, sql As String
Private Sub Form_Load()
Dim fld
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db_medicine.mdb;Persist Security Info=False"
Adodc1.RecordSource = "select * from tb_kc"
Adodc1.Refresh
sql = "tb_kc"
Set fld = Adodc1.Recordset.Fields
For Each fld In Adodc1.Recordset.Fields
'向combo控件中添加字段
cboFields.AddItem fld.Name
Next
cboFields.ListIndex = 0
'向cboOperator中添加查詢條件
cboOperator.AddItem ("like")
cboOperator.AddItem (">")
cboOperator.AddItem ("=")
cboOperator.AddItem (">=")
cboOperator.AddItem ("<")
cboOperator.AddItem ("<=")
cboOperator.AddItem ("<>")
cboOperator.ListIndex = 0
'Download by <a href="http://www.srcfans.comEnd">http://www.srcfans.com End</a> Sub
Private Sub ExptoExcel()
Dim i As Integer, r As Integer, c As Integer
Dim newxls As New Excel.Application
Dim newbook As New Excel.Workbook
Dim newsheet As New Excel.Worksheet
Set newbook = newxls.Workbooks.Add '創建工作簿
Set newsheet = newbook.Worksheets(1) '創建工作表
If sql <> "" Then
Adodc1.RecordSource = sql
Adodc1.Refresh
End If
If Adodc1.Recordset.RecordCount > 0 Then
For i = 0 To DataGrid1.Columns.Count - 1
newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
Next i
'指定表格內容
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
r = Adodc1.Recordset.AbsolutePosition
For c = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Col = c
newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
Next c
Adodc1.Recordset.MoveNext
Loop
Dim myval As Long
Dim mystr As String
myval = MsgBox("是否保存該Excel表?", vbYesNo, "提示窗口")
If myval = vbYes Then
mystr = InputBox("請輸入文件名稱", "輸入窗口")
If Len(mystr) = 0 Then
MsgBox "系統不允許文件名稱為空！", , "提示窗口"
Exit Sub
End If
On Error GoTo ErrSave
newsheet.SaveAs App.Path & "\Excel文件\" & mystr & ".xls"
MsgBox "Excel文件保存成功，位置：" & App.Path & "\Excel文件\" & mystr & ".xls", , "提示窗口"
newxls.Quit
ErrSave:
Exit Sub
MsgBox Err.Description, , "提示窗口"
End If
End If
End Sub
Private Sub ExptoWord()
Dim i As Integer, j As Integer
Dim ifieldcount As Integer, irecordcount As Integer
Dim wdapp As Word.Application
Dim wddoc As Word.Document
Dim atable As Word.Table
' cmdFind_Click
If Adodc1.Recordset.RecordCount > 0 Then
irecordcount = Adodc1.Recordset.RecordCount
'創建word應用程序，這一句話打開word2000
Set wdapp = CreateObject("Word.Application")
'在word中添加一個新文檔
Set wddoc = wdapp.Documents.Add
With wdapp
.Visible = True
.Activate
'在word中增加一個表格
.Caption = "商品信息表"
Set atable = .ActiveDocument.Tables.Add(.Selection.Range, irecordcount + 1, 12)
atable.Cell(1, 1).Range.InsertAfter "商品編號"
atable.Cell(1, 2).Range.InsertAfter "商品名稱"
atable.Cell(1, 3).Range.InsertAfter "拼音碼"
atable.Cell(1, 4).Range.InsertAfter "批號"
atable.Cell(1, 5).Range.InsertAfter "產地"
atable.Cell(1, 6).Range.InsertAfter "規格"
atable.Cell(1, 7).Range.InsertAfter "包裝"
atable.Cell(1, 8).Range.InsertAfter "單位"
atable.Cell(1, 9).Range.InsertAfter "進價"
atable.Cell(1, 10).Range.InsertAfter "庫存"
atable.Cell(1, 11).Range.InsertAfter "盤點數量"
atable.Cell(1, 12).Range.InsertAfter "盤點盈虧數量"
'指定表格內容
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
atable.Cell(DataGrid1.Bookmark + 1, 1).Range.InsertAfter Adodc1.Recordset.Fields("商品編號")
atable.Cell(DataGrid1.Bookmark + 1, 2).Range.InsertAfter Adodc1.Recordset.Fields("商品名稱")
atable.Cell(DataGrid1.Bookmark + 1, 3).Range.InsertAfter Adodc1.Recordset.Fields("拼音碼")
If Adodc1.Recordset.Fields("批號") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 4).Range.InsertAfter Adodc1.Recordset.Fields("批號")
If Adodc1.Recordset.Fields("產地") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 5).Range.InsertAfter Adodc1.Recordset.Fields("產地")
If Adodc1.Recordset.Fields("規格") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 6).Range.InsertAfter Adodc1.Recordset.Fields("規格")
If Adodc1.Recordset.Fields("包裝") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 7).Range.InsertAfter Adodc1.Recordset.Fields("包裝")
If Adodc1.Recordset.Fields("單位") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 8).Range.InsertAfter Adodc1.Recordset.Fields("單位")
If Adodc1.Recordset.Fields("進價") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 9).Range.InsertAfter Adodc1.Recordset.Fields("進價")
If Adodc1.Recordset.Fields("庫存") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 10).Range.InsertAfter Adodc1.Recordset.Fields("庫存")
If Adodc1.Recordset.Fields("盤點數量") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 11).Range.InsertAfter Adodc1.Recordset.Fields("盤點數量")
If Adodc1.Recordset.Fields("盤點盈虧數量") <> "" Then atable.Cell(DataGrid1.Bookmark + 1, 12).Range.InsertAfter Adodc1.Recordset.Fields("盤點盈虧數量")
Adodc1.Recordset.MoveNext
Loop
End With
'清除word對象
Set wdapp = Nothing
Set wddoc = Nothing
Else
MsgBox "沒有商品！", , "提示窗口"
End If
End Sub
Private Sub cFind() '查詢
tb = "tb_kc"
Select Case Adodc1.Recordset.Fields(cboFields.ListIndex).Type
Case 202 '字符數據
If cboOperator.Text = "like" Then
sql = tb & " where " & tb & "." & cboFields & " like+ '" + txtdata + "'+'%'"
Else
sql = tb & " where " & tb & "." & cboFields & cboOperator & "'" + txtdata + "'"
End If
Case 5 '貨幣數據
If IsNumeric(txtdata) = False Then
MsgBox "請輸入正確的數據！", , "提示窗口"
Exit Sub
End If
If cboOperator.Text = "like" Then
MsgBox "貨幣數據不能選用“Like”作為運算符！", , "提示窗口"
cboOperator.ListIndex = 1
End If
sql = tb & " where " & tb & "." & cboFields & cboOperator & txtdata
Case 3 '數字數據
If IsNumeric(txtdata) = False Then
MsgBox "請輸入正確的數據！", , "提示窗口"
Exit Sub
End If
If cboOperator.Text = "like" Then
MsgBox "數字數據不能選用“Like”作為運算符！", , "提示窗口"
cboOperator.ListIndex = 1
End If
sql = tb & " where " & tb & "." & cboFields & cboOperator & txtdata
End Select
If sql <> "" Then
Adodc1.RecordSource = sql
Adodc1.Refresh
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Caption
Case "查詢"
cFind
Case "導出到Word"
ExptoWord
Case "導出到Excel"
ExptoExcel
Case "導出到HTML"
If DataEnvironment1.Connection1.State = adStateOpen Then
DataEnvironment1.Connection1.Close
End If
DataEnvironment1.Connection1.Open
DataEnvironment1.Commands(1).ActiveConnection = DataEnvironment1.Connection1
DataEnvironment1.Commands(1).CommandText = sql
DataReport1.Refresh
DataReport1.ExportReport rptKeyHTML, "" & App.Path & "\Myfile.htm ", True, , rptRangeAllPages
MsgBox "文件已導出到工程目錄下！", vbInformation, "信息提示"
Case "打印"
If DataEnvironment1.Connection1.State = adStateOpen Then
DataEnvironment1.Connection1.Close
End If
DataEnvironment1.Connection1.Open
DataEnvironment1.Commands(1).ActiveConnection = DataEnvironment1.Connection1
DataEnvironment1.Commands(1).CommandText = sql
DataReport1.Show
DataReport1.Refresh
DataReport1.Show
Case "退出"
End
End Select
End Sub
這里可以代碼高亮，看的更清：Vb導出數據到Excel或word文件中