网页素材: 导航菜单选项卡滑动门焦点图图片切换下拉菜单弹出层Tabs链接提示

您的当前位置: 源码爱好者 » 网页制作教程(编程教程) » VB技术教程

Vb 6导出内容到Excel或word文件中

  • 标签:报表导出 更新时间:2014-07-22
  • 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
    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 http://www.codefans.net
    End 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

  • 已读: 次 收藏本文关闭本文打印本文复制链接
处理 SSI 文件时出错