打印_excel.frm

本软件为咨询公司开发的合同管理软件,运用MDB数据库.

VERSION 5.00
Begin VB.Form 打印合同信息 
   Caption         =   "合同信息登记表打印"
   ClientHeight    =   2430
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   Icon            =   "打印_excel.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2430
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "打印方式选择"
      Height          =   1455
      Left            =   360
      TabIndex        =   2
      Top             =   360
      Width           =   2295
      Begin VB.OptionButton Option2 
         Caption         =   "输出到打印机"
         Height          =   180
         Left            =   240
         TabIndex        =   4
         Top             =   960
         Width           =   1455
      End
      Begin VB.OptionButton Option1 
         Caption         =   "输出到Excel表"
         Height          =   300
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Value           =   -1  'True
         Width           =   1575
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取   消"
      Height          =   375
      Left            =   3000
      TabIndex        =   1
      Top             =   1440
      Width           =   1335
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   720
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   2040
      Visible         =   0   'False
      Width           =   1140
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打  印"
      Height          =   375
      Left            =   3000
      TabIndex        =   0
      Top             =   600
      Width           =   1335
   End
End
Attribute VB_Name = "打印合同信息"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim strSource, strDestination As String
Dim jls, i, j, f, k, n As Integer
'Dim dblj As String
Dim dylj As String
Dim htdb As ADODB.Connection
Dim htrs As ADODB.Recordset

Private Sub Command1_Click()
    On Error GoTo er
    
    Set htdb = New ADODB.Connection
    htdb.CursorLocation = adUseClient
    htdb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
    Set htrs = New ADODB.Recordset
    sqltr = "select * from 合同信息表  where " & "编号=" & "'" & htbh & "'"
    htrs.Open sqltr, htdb, adOpenKeyset, adLockOptimistic

    If Option1 = True Then
  
    Set xlApp = New Excel.Application   '建立excel应用程序
    Set xlApp = CreateObject("Excel.Application")    '激活EXCEL应用程序
   'Set xlbook = xlApp.Workbooks.Add
         '设定工作表
       
    strSource = App.Path + "\rpt\合同信息表.xls"             'jcchzb.xls是一个模版文件
    strDestination = App.Path + "\temp\合同信息表.xls"
    FileCopy strSource, strDestination              '将模版文件拷贝到一个临时文件

    Set xlbook = xlApp.Workbooks.Open(strDestination) '打开工作簿，strDestination为一个EXCEL报表文件
    Set xlsheet = xlbook.Worksheets(1)    '打开工作表1
    
   
    
    xlsheet.Cells(3, 2) = Trim(htrs!编号)
    xlsheet.Cells(3, 4) = Trim(htrs!单位名称)
    xlsheet.Cells(3, 6) = Trim(htrs!体系)
    xlsheet.Cells(4, 2) = Trim(htrs!部门责任人)
    xlsheet.Cells(4, 4) = Trim(htrs!签约人)
    xlsheet.Cells(4, 6) = Trim(htrs!咨询师)
    xlsheet.Cells(5, 2) = Trim(htrs!签订日期)
    xlsheet.Cells(5, 4) = Trim(htrs!启动日期)
    xlsheet.Cells(5, 6) = Trim(htrs!发证日期)
    xlsheet.Cells(6, 2) = Trim(htrs!认证机构)
    xlsheet.Cells(6, 4) = Trim(htrs!认证性质)
    xlsheet.Cells(6, 6) = Trim(htrs!合同金额)
    xlsheet.Cells(7, 2) = Trim(htrs!认证费)
    xlsheet.Cells(7, 4) = Trim(htrs!咨询费)
    xlsheet.Cells(8, 2) = Trim(htrs!备注)
    xlsheet.Cells(10, 5) = "日期：" & Date
    
    xlApp.Caption = "表打印预览"
    xlApp.Visible = True
    xlApp.ActiveSheet.PrintPreview            '打印预览
    xlbook.Save  '保存文件
    xlbook.Close
    xlApp.quit  '退出EXCEL
   htrs.ActiveConnection = Nothing
   htdb.Close

    Else
    If Option2 = True Then
    
    End If
    End If
   
  
   ' If Option1 = True Then
   ' xlApp.Visible = True
   ' xlbook.Save  '保存文件
   ' Else
   ' If Option2 = True Then
  
  '  xlApp.Visible = True
  '  xlApp.Caption = "表打印预览"
  '  xlApp.ActiveSheet.PrintPreview            '打印预览
  '  xlbook.Save  '保存文件
  '  xlApp.Quit  '退出EXCEL
  '  End If
  '  End If
    
   
Unload Me


Exit Sub
er:
   htrs.ActiveConnection = Nothing
   htdb.Close
   xlbook.Close
   xlApp.quit  '退出EXCEL
Unload Me
End Sub

Private Sub Command2_Click()
   Unload Me
End Sub

Private Sub Form_Load()
'dblj = App.Path & "\data\htxxk.mdb"

End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo er
er:
End Sub