这段程序,根据数据库的内容每一页打印三张凭证,hz1_file_path 变量就是凭证的模版,改写完毕,打印,当关闭的时候,就提示文件内容已改写,是否保存!
If Dir(hz1_file_path) = "" Then
Call MsgBox("对不起,当前找不到" + hz1_file_path + "这个模版文件,不能打印这个凭证!", vbExclamation, "警告")
Exit Sub
End If
Label2.Caption = "←"
Label2.Refresh
Text2.Text = "正在启动Excel程序引擎启动......" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
Dim xlexcel1 As New Excel.Application '定义EXECL类
Dim xlBook1 As New Excel.Workbook
Dim xlsheet1 As New Excel.Worksheet
xlexcel1.Visible = False '将EXECL设为不可见
Set xlBook1 = xlexcel1.Workbooks.Open(hz1_file_path) '打开EXCEL工作
Set xlsheet1 = xlBook1.Worksheets(1) '选择工作簿
xlsheet1.Activate '激活工作表
Text2.Text = "Excel程序引擎启动完毕!" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
Text2.Text = "正在启动数据库引擎......" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
Dim cnn1 As New ADODB.connection
Dim rs1 As New ADODB.Recordset
Dim sql1 As String
sql1 = "select * from lp_zzpz where bz=1"
cnn1.Open connection
rs1.Open sql1, cnn1, 1, 1
allhs = rs1.RecordCount
zfjhs = 0
Text2.Text = "数据库引擎启动完毕!" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
Text2.Text = "正在打印汇总转帐凭证" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
ProgressBar1.Value = 0
If Not rs1.EOF Then
Do While Not rs1.EOF
xlsheet1.Cells(3, 3) = Left(Trim(system_xtrq), 4) + "年" + Left(Right(Trim(system_xtrq), 6), 2) + "月" + Right(Trim(system_xtrq), 2) + "日"
xlsheet1.Cells(3, 6) = "第" + Trim(CInt(rs1("pz_bh"))) + "号"
xlsheet1.Cells(5, 2) = Trim(rs1("zh1"))
xlsheet1.Cells(5, 4) = Trim(rs1("zy1"))
xlsheet1.Cells(5, 6) = Trim(rs1("je"))
xlsheet1.Cells(8, 6) = Trim(rs1("je"))
xlsheet1.Cells(10, 2) = "会计主管 授权 复核 录入"
zfjhs = zfjhs + 1
If zfjhs > allhs Then
zfjhs = allhs
End If
ProgressBar1.Value = zfjhs / allhs * 100
rs1.MoveNext
If rs1.EOF Then
xlsheet1.PrintOut
Exit Do
End If
xlsheet1.Cells(15, 3) = Left(Trim(system_xtrq), 4) + "年" + Left(Right(Trim(system_xtrq), 6), 2) + "月" + Right(Trim(system_xtrq), 2) + "日"
xlsheet1.Cells(15, 6) = "第" + Trim(CInt(rs1("pz_bh"))) + "号"
xlsheet1.Cells(17, 2) = Trim(rs1("zh1"))
xlsheet1.Cells(17, 4) = Trim(rs1("zy1"))
xlsheet1.Cells(17, 6) = Trim(rs1("je"))
xlsheet1.Cells(20, 6) = Trim(rs1("je"))
xlsheet1.Cells(22, 2) = "会计主管 授权 复核 录入"
rs1.MoveNext
zfjhs = zfjhs + 1
If zfjhs > allhs Then
zfjhs = allhs
End If
ProgressBar1.Value = zfjhs / allhs * 100
If rs1.EOF Then
xlsheet1.PrintOut
Exit Do
End If
xlsheet1.Cells(27, 3) = Left(Trim(system_xtrq), 4) + "年" + Left(Right(Trim(system_xtrq), 6), 2) + "月" + Right(Trim(system_xtrq), 2) + "日"
xlsheet1.Cells(27, 6) = "第" + Trim(CInt(rs1("pz_bh"))) + "号"
xlsheet1.Cells(29, 2) = Trim(rs1("zh1"))
xlsheet1.Cells(29, 4) = Trim(rs1("zy1"))
xlsheet1.Cells(29, 6) = Trim(rs1("je"))
xlsheet1.Cells(32, 6) = Trim(rs1("je"))
xlsheet1.Cells(34, 2) = "会计主管 授权 复核 录入"
xlsheet1.PrintOut
rs1.MoveNext
zfjhs = zfjhs + 1
If zfjhs > allhs Then
zfjhs = allhs
End If
ProgressBar1.Value = zfjhs / allhs * 100
Loop
End If
Text2.Text = "汇总转帐凭证打印完毕!" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
rs1.Close
Set rs1 = Nothing
Set cnn1 = Nothing
Text2.Text = "关闭数据库引擎!" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
xlexcel1.Quit '结束EXCEL对象
Set xlBook1 = Nothing
Set xlexcel1 = Nothing
Text2.Text = "关闭Execl程序引擎!" + Chr(13) + Chr(10) + Text2.Text
Text2.Refresh
Label2.Caption = "√"
Label2.Refresh