vsprinter(初学时一个非常有用的例子)
2007-02-07 15:03
169 查看
Option Explicit
Public Function formatData2(ByVal data1 As Double, ByVal data2 As Double) As String
Dim dt1, dt2 As Double
dt1 = data1
dt2 = data2
If dt1 = 0 Or dt1 = 0# Or dt2 = 0 Or dt2 = 0# Then
formatData2 = "0.00"
Else
formatData2 = Format(Round(dt1 / dt2, 2), "0.00")
End If
End Function
Public Sub print_jian_anhuizong(ByRef printCtl As VSPrinter, ByVal strTable As String, ByVal strTitle)
Dim con As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim str_table As String
Dim str_title As String
Dim strSql As String
Dim iCurrent As Integer
Dim cols As Integer '页面表格的列数
Dim iCurrenrows As Integer '页面表格当前显示的总行数
Dim Rows As Long '总行数
Dim Trows As Long '页面表格总行数
Dim pages As Integer '总页数
Dim iPage As Integer '当前页面
Dim iLastrows As Integer '整页显示后剩余的行数
Dim iRow As Long '当前行的位置
On Error GoTo err1
str_table = strTable
str_title = strTitle
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"
con.Open
strSql = "select nn,name,unit,pricezhijiegongcheng,pricezhijie,pricerengong,pricecailiao,pricejixie," & _
"priceqitazhijie,pricexianchang,pricejianjie,pricejihualirun,priceshuijin,priceshashijiacha ,price1 from " & str_table & " order by nn"
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.Open strSql, con, , , adCmdText
cols = 13
If Not rst.BOF And Not rst.EOF Then
'获得总的记录数rows
rst.MoveFirst
Do While Not rst.EOF
Rows = Rows + 1
rst.MoveNext
Loop
'重新设置行的位置为第一条记录
rst.MoveFirst
'设置总的页面数
If Rows <= 18 Then '总行数小于等于页面显示的总行数
pages = 1
iCurrenrows = Rows
iLastrows = 0
Else '总行数大于页面显示的总行数
If Rows Mod 18 = 0 Then '总行数等于页面显示的总行数倍数
pages = Int(Rows / 18)
iLastrows = 0
Else '总行数不等于页面显示的总行数倍数
pages = Int(Rows / 18) + 1
iLastrows = Rows Mod 18
End If
iCurrenrows = 18
End If
iPage = 1 '设置当前页面为第一页面
iRow = 0 '设置当前行位置为空
'
With printCtl
.Orientation = orLandscape '设置横向打印
.TableBorder = tbAll
'设置页面四边的边距
.MarginTop = 1400
.MarginBottom = 1400
.MarginLeft = 1400
.MarginRight = 1400
'设置字体名字
'*************************************开始打印文档的内容************************************* .StartDoc
.StartDoc
.TablePen = 20
For iPage = 1 To pages
'设置标题
.FontSize = 14
.FontBold = True
.TextAlign = taCenterMiddle
.Paragraph = str_title
.Paragraph = ""
.FontBold = False
.FontSize = 10
'设置页面表格
.FontSize = 9
.StartTable
.TextAlign = taRightMiddle
.Paragraph = "单位: 元"
.StartTable
.TableCell(tcCols) = cols
If iPage = pages And iLastrows <> 0 Then
Trows = iLastrows + 2
Else
Trows = iCurrenrows + 2
End If
.TableCell(tcRows) = Trows
'///
.TableCell(tcRowHeight) = 400
.TableCell(tcColWidth, , 1) = 600
.TableCell(tcColWidth, , 2) = 2600
.TableCell(tcColWidth, , 3) = 1000
.TableCell(tcColWidth, , 4) = 1000
.TableCell(tcColWidth, , 5) = 1000
.TableCell(tcColWidth, , 6) = 1000
.TableCell(tcColWidth, , 7) = 1000
.TableCell(tcColWidth, , 8) = 1000
.TableCell(tcColWidth, , 9) = 1000
.TableCell(tcColWidth, , 10) = 1000
.TableCell(tcColWidth, , 11) = 1000
.TableCell(tcColWidth, , 12) = 1000
.TableCell(tcColWidth, , 13) = 1000
.TableCell(tcColSpan, 1, 4) = 10
.TableCell(tcRowSpan, 1, 1) = 2
.TableCell(tcRowSpan, 1, 2) = 2
.TableCell(tcRowSpan, 1, 3) = 2
'///
.TableCell(tcText, 1, 1) = "序号"
.TableCell(tcText, 1, 2) = "工程单价名称"
.TableCell(tcText, 1, 3) = "单价"
.TableCell(tcText, 1, 4) = "其中"
.TableCell(tcText, 2, 4) = "人工费"
.TableCell(tcText, 2, 5) = "材料费"
.TableCell(tcText, 2, 6) = "机械费"
.TableCell(tcText, 2, 7) = "其他直接费"
.TableCell(tcText, 2, 8) = "现场经费"
.TableCell(tcText, 2, 9) = "直接工程费"
.TableCell(tcText, 2, 10) = "间接费"
.TableCell(tcText, 2, 11) = "计划利润"
.TableCell(tcText, 2, 12) = "税金"
.TableCell(tcText, 2, 13) = "材差"
'///
.TableCell(tcAlign, 1, 1, 1, 13) = taCenterMiddle '标题行居中对齐
.TableCell(tcAlign, 2, 4, 2, 13) = taCenterMiddle '标题行居中对齐
.TableCell(tcAlign, 3, 1, Trows, 1) = taCenterMiddle '第一列居中对齐
.TableCell(tcAlign, 3, 2, Trows, 2) = taLeftMiddle '第二列居中左对齐
.TableCell(tcAlign, 3, 3, Trows, 13) = taRightMiddle '其他列居中右对齐
'*************************************向每一页面添加数据*************************************
iCurrent = 0
Do While Not rst.EOF
iRow = iRow + 1
'当当前页面数据添加完后退出循环,开始下一页面
If iCurrent <> 0 And iCurrent Mod 18 = 0 Then
Exit Do
End If
.TableCell(tcText, 3 + iCurrent, 1) = rst.Fields("nn") & ""
.TableCell(tcText, 3 + iCurrent, 2) = rst.Fields("name") & ""
.TableCell(tcText, 3 + iCurrent, 3) = formatData2(Val(rst.Fields("price1") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 4) = formatData2(Val(rst.Fields("pricerengong") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 5) = formatData2(Val(rst.Fields("pricecailiao") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 6) = formatData2(Val(rst.Fields("pricejixie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 7) = formatData2(Val(rst.Fields("priceqitazhijie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 8) = formatData2(Val(rst.Fields("pricexianchang") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 9) = formatData2(Val(rst.Fields("pricezhijiegongcheng") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 10) = formatData2(Val(rst.Fields("pricejianjie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 11) = formatData2(Val(rst.Fields("pricejihualirun") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 12) = formatData2(Val(rst.Fields("priceshuijin") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 13) = formatData2(Val(rst.Fields("priceshashijiacha") & ""), Val(rst.Fields("unit") & ""))
rst.MoveNext
iCurrent = iCurrent + 1
Loop
.EndTable
'判断当前记录的位置是否为最后一条,如果不是最后一条,开始新的一页
If iRow < Rows Then
.NewPage '开始新的一页
End If
Next iPage
'*************************************结束打印文档*************************************
.EndDoc
End With
Else
MsgBox "没有要打印的数据", vbOKOnly + vbInformation
End If
rst.Close
con.Close
Set rst = Nothing
Set con = Nothing
Exit Sub
err1:
MsgBox Err.Description, vbOKOnly + vbInformation, "提示"
End Sub
Public Function formatData2(ByVal data1 As Double, ByVal data2 As Double) As String
Dim dt1, dt2 As Double
dt1 = data1
dt2 = data2
If dt1 = 0 Or dt1 = 0# Or dt2 = 0 Or dt2 = 0# Then
formatData2 = "0.00"
Else
formatData2 = Format(Round(dt1 / dt2, 2), "0.00")
End If
End Function
Public Sub print_jian_anhuizong(ByRef printCtl As VSPrinter, ByVal strTable As String, ByVal strTitle)
Dim con As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim str_table As String
Dim str_title As String
Dim strSql As String
Dim iCurrent As Integer
Dim cols As Integer '页面表格的列数
Dim iCurrenrows As Integer '页面表格当前显示的总行数
Dim Rows As Long '总行数
Dim Trows As Long '页面表格总行数
Dim pages As Integer '总页数
Dim iPage As Integer '当前页面
Dim iLastrows As Integer '整页显示后剩余的行数
Dim iRow As Long '当前行的位置
On Error GoTo err1
str_table = strTable
str_title = strTitle
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"
con.Open
strSql = "select nn,name,unit,pricezhijiegongcheng,pricezhijie,pricerengong,pricecailiao,pricejixie," & _
"priceqitazhijie,pricexianchang,pricejianjie,pricejihualirun,priceshuijin,priceshashijiacha ,price1 from " & str_table & " order by nn"
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.Open strSql, con, , , adCmdText
cols = 13
If Not rst.BOF And Not rst.EOF Then
'获得总的记录数rows
rst.MoveFirst
Do While Not rst.EOF
Rows = Rows + 1
rst.MoveNext
Loop
'重新设置行的位置为第一条记录
rst.MoveFirst
'设置总的页面数
If Rows <= 18 Then '总行数小于等于页面显示的总行数
pages = 1
iCurrenrows = Rows
iLastrows = 0
Else '总行数大于页面显示的总行数
If Rows Mod 18 = 0 Then '总行数等于页面显示的总行数倍数
pages = Int(Rows / 18)
iLastrows = 0
Else '总行数不等于页面显示的总行数倍数
pages = Int(Rows / 18) + 1
iLastrows = Rows Mod 18
End If
iCurrenrows = 18
End If
iPage = 1 '设置当前页面为第一页面
iRow = 0 '设置当前行位置为空
'
With printCtl
.Orientation = orLandscape '设置横向打印
.TableBorder = tbAll
'设置页面四边的边距
.MarginTop = 1400
.MarginBottom = 1400
.MarginLeft = 1400
.MarginRight = 1400
'设置字体名字
'*************************************开始打印文档的内容************************************* .StartDoc
.StartDoc
.TablePen = 20
For iPage = 1 To pages
'设置标题
.FontSize = 14
.FontBold = True
.TextAlign = taCenterMiddle
.Paragraph = str_title
.Paragraph = ""
.FontBold = False
.FontSize = 10
'设置页面表格
.FontSize = 9
.StartTable
.TextAlign = taRightMiddle
.Paragraph = "单位: 元"
.StartTable
.TableCell(tcCols) = cols
If iPage = pages And iLastrows <> 0 Then
Trows = iLastrows + 2
Else
Trows = iCurrenrows + 2
End If
.TableCell(tcRows) = Trows
'///
.TableCell(tcRowHeight) = 400
.TableCell(tcColWidth, , 1) = 600
.TableCell(tcColWidth, , 2) = 2600
.TableCell(tcColWidth, , 3) = 1000
.TableCell(tcColWidth, , 4) = 1000
.TableCell(tcColWidth, , 5) = 1000
.TableCell(tcColWidth, , 6) = 1000
.TableCell(tcColWidth, , 7) = 1000
.TableCell(tcColWidth, , 8) = 1000
.TableCell(tcColWidth, , 9) = 1000
.TableCell(tcColWidth, , 10) = 1000
.TableCell(tcColWidth, , 11) = 1000
.TableCell(tcColWidth, , 12) = 1000
.TableCell(tcColWidth, , 13) = 1000
.TableCell(tcColSpan, 1, 4) = 10
.TableCell(tcRowSpan, 1, 1) = 2
.TableCell(tcRowSpan, 1, 2) = 2
.TableCell(tcRowSpan, 1, 3) = 2
'///
.TableCell(tcText, 1, 1) = "序号"
.TableCell(tcText, 1, 2) = "工程单价名称"
.TableCell(tcText, 1, 3) = "单价"
.TableCell(tcText, 1, 4) = "其中"
.TableCell(tcText, 2, 4) = "人工费"
.TableCell(tcText, 2, 5) = "材料费"
.TableCell(tcText, 2, 6) = "机械费"
.TableCell(tcText, 2, 7) = "其他直接费"
.TableCell(tcText, 2, 8) = "现场经费"
.TableCell(tcText, 2, 9) = "直接工程费"
.TableCell(tcText, 2, 10) = "间接费"
.TableCell(tcText, 2, 11) = "计划利润"
.TableCell(tcText, 2, 12) = "税金"
.TableCell(tcText, 2, 13) = "材差"
'///
.TableCell(tcAlign, 1, 1, 1, 13) = taCenterMiddle '标题行居中对齐
.TableCell(tcAlign, 2, 4, 2, 13) = taCenterMiddle '标题行居中对齐
.TableCell(tcAlign, 3, 1, Trows, 1) = taCenterMiddle '第一列居中对齐
.TableCell(tcAlign, 3, 2, Trows, 2) = taLeftMiddle '第二列居中左对齐
.TableCell(tcAlign, 3, 3, Trows, 13) = taRightMiddle '其他列居中右对齐
'*************************************向每一页面添加数据*************************************
iCurrent = 0
Do While Not rst.EOF
iRow = iRow + 1
'当当前页面数据添加完后退出循环,开始下一页面
If iCurrent <> 0 And iCurrent Mod 18 = 0 Then
Exit Do
End If
.TableCell(tcText, 3 + iCurrent, 1) = rst.Fields("nn") & ""
.TableCell(tcText, 3 + iCurrent, 2) = rst.Fields("name") & ""
.TableCell(tcText, 3 + iCurrent, 3) = formatData2(Val(rst.Fields("price1") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 4) = formatData2(Val(rst.Fields("pricerengong") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 5) = formatData2(Val(rst.Fields("pricecailiao") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 6) = formatData2(Val(rst.Fields("pricejixie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 7) = formatData2(Val(rst.Fields("priceqitazhijie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 8) = formatData2(Val(rst.Fields("pricexianchang") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 9) = formatData2(Val(rst.Fields("pricezhijiegongcheng") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 10) = formatData2(Val(rst.Fields("pricejianjie") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 11) = formatData2(Val(rst.Fields("pricejihualirun") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 12) = formatData2(Val(rst.Fields("priceshuijin") & ""), Val(rst.Fields("unit") & ""))
.TableCell(tcText, 3 + iCurrent, 13) = formatData2(Val(rst.Fields("priceshashijiacha") & ""), Val(rst.Fields("unit") & ""))
rst.MoveNext
iCurrent = iCurrent + 1
Loop
.EndTable
'判断当前记录的位置是否为最后一条,如果不是最后一条,开始新的一页
If iRow < Rows Then
.NewPage '开始新的一页
End If
Next iPage
'*************************************结束打印文档*************************************
.EndDoc
End With
Else
MsgBox "没有要打印的数据", vbOKOnly + vbInformation
End If
rst.Close
con.Close
Set rst = Nothing
Set con = Nothing
Exit Sub
err1:
MsgBox Err.Description, vbOKOnly + vbInformation, "提示"
End Sub
相关文章推荐
- 一个非常有用的关于集合的例子,实现集合的add,remove和this[index]方法
- 在看官方的例子时候由一个grid实例,在每一行之前有个加号,展开可以显示内容,在实际应用中还是非常有用的,照搬例子的代码,发现老是提示对象不存在,查阅资料后发现是没有加载插件,这里和大家分享下Ext.grid.RowExpander插件的使用,
- Android一个小球弹跳的例子,希望对大家有用
- EXTJS动态树,非常完整的一个例子
- 一个非常出色的gtk例子
- ASP 编程中 20 个非常有用的例子
- 一个NB的博客 个人感觉非常有用
- ASP 编程中20个非常有用的例子
- ASP 编程中20个非常有用的例子(一)
- 编程中20 个非常有用的例子ASP
- 一个非常有用的自定义聚集函数
- ASP 编程中 15 个非常有用的例子
- 这是一个非常有趣的例子!(DotNET密码系统)
- ASP编程中20个非常有用的例子
- 一个非常完整的AJAX的例子,注释也很全
- ASP.NET编程中非常有用的例子
- 转贴: ASP 编程中 20 个非常有用的例子! 求精
- qt4.0一个非常有用的类QSettings
- ASP编程中20个非常有用的例子