vb猜价格,用vb编写打印工资条程序怎么打印
Public Sub PrintsalaryList1()
' Dim printer As Printer '初始化Printer对象
Dim PageHeader As Long '打印页上部留空
Dim PageFooter As Long '打印页下部留空
Dim PageLeft As Long '打印页左部留空
Dim PageRight As Long '打印页右部留空
Dim UseWidth As Long
Dim UseHeight As Long
Dim i, j, k, c, b As Integer
Dim Word As String
Dim StartX As Long
Dim StartY As Long
Dim StartyLine As Long '用来纪录打印竖线的起点
Dim EndyLine As Long ' 用来纪录打印竖线的末点
Dim strTitle As String
Const w1 = 1.5, w2 = 2 '设置线与字段之间的距离
Const h = 14 '设置表格的高度
Dim v(40) As Variant '定义数组 将字段值导入
Dim N As Integer '用于记录表的列数
Dim l1, l2, m, t As Variant
'设置标题
strTitle = t1
N = Adodc1.Recordset.Fields.Count
' Dim strSubTitle As String
' strSubTitle = "Printer对象打印报表实例"
'建立一个ADO数据连接
' Dim DataConn As New ADODB.Connection
' Dim DataRec As New ADODB.Recordset
' Dim strSQL As String
'若数据库连接出错,则转向ConnectionERR
' On Error GoTo ConnectionERR
' '建立一个连接字串
' '这个连接串可能根据数据库配置的不同而不同
' DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;"
' DataConn.ConnectionString = DataConn.ConnectionString & "Persist Security Info=False;"
' DataConn.ConnectionString = DataConn.ConnectionString & "Initial Catalog=pubs;"
' DataConn.ConnectionString = DataConn.ConnectionString & "Data Source=land-net"
' '建立数据库连接
' DataConn.Open
' '若RecordSet建立出错,则转向RecordsetERR
' On Error GoTo RecordSetERR
' strSQL = "SELECT au_lname,au_fname,phone "
' '从表authors查询
' strSQL = strSQL & "FROM authors"
' DataRec.Open strSQL, DataConn
' On Error GoTo PrintERR
'设置页面参数
On Error GoTo PrintERR
PageHeader = 5
PageFooter = 25
PageLeft = 20
PageRight = 20
With Printer
.ScaleMode = 6
.ScaleLeft = 0
.ScaleTop = -5
'设置纸型
.PaperSize = psize
.FontSize = fsize
' .ScaleWidth = 210
' .ScaleHeight = 297
UseWidth = .ScaleWidth
UseHeight = .ScaleHeight – 30
.CurrentX = 0
.CurrentY = 0
.DrawWidth = 1
.DrawStyle = 6
End With
'打印数据和网格线
Dim yy As Variant
yy = 0
c = 0
Do Until Adodc1.Recordset.EOF
'将字段值导入到数组中去
For b = 0 To N – 1
v(b) = "" & Adodc1.Recordset.Fields(b).Value
Next b
' '判断是否该页已打满,若已满,开始新的一页
If Printer.CurrentY >= UseHeight Then
'开始新的一页
Printer.NewPage
End If
' 设置打印头的初始位置
With Printer
.CurrentX = PageLeft + .ScaleLeft
.CurrentY = PageHeader + yy
' StartyLine = .CurrentY
End With
'' 打印标题
With Printer
.CurrentX = (UseWidth – .TextWidth(strTitle)) / 2
' .CurrentY = PageHeader + .ScaleTop
End With
Printer.Print strTitle
' 保存坐标y
Dim x1, y1, x2, y2 As Variant
y1 = PageHeader + yy + 1
' '打印表格的第一条线
'注意:Line方法不能用在With ….End With块里
' 确定字段的总宽度
m = 0
For i = 0 To N – 1
l1 = Printer.TextWidth(Trim(pp(i)))
' If v(i) = Null Then
' l2 = 0
' Else
l2 = Printer.TextWidth(Trim(v(i)))
' End If
If l1 >= l2 Then
m = m + l1 + 2 * w1
Else: m = m + l2 + 2 * w1
End If
Next i
' 设置打印头坐标
With Printer
.CurrentX = (UseWidth + m) / 2
.CurrentY = y1 + 5
End With
Printer.Line -((UseWidth – m) / 2, Printer.CurrentY)
y2 = Printer.CurrentY
x2 = Printer.CurrentX
' '打印表头
' 打印第一条竖线
Printer.Line -(x2, y2 + h / 2)
'' 打印其他的字段和竖线
Dim p1, p2 As Variant
p1 = x2 + w1
p2 = y2 + w2
l1 = 0
l2 = 0
For j = 0 To N – 1
Printer.CurrentX = p1
Printer.CurrentY = p2
l1 = Printer.TextWidth(Trim(pp(j)))
l2 = Printer.TextWidth(Trim(v(j)))
If l1 >= l2 Then
p1 = p1 + l1 + 2 * w1
Else
p1 = p1 + l2 + 2 * w1
End If
Printer.Print pp(j)
Printer.Line (p1 – w1, y2 + h / 2)-(p1 – w1, y2)
Next j
' 打印中间的横线
Printer.Line (p1 – w1, y2 + h / 2)-(x2, y2 + h / 2)
'' 打印字段数据
' 打印第一条竖线
Printer.Line (x2, y2 + h / 2)-(x2, y2 + h)
' 打印其他的字段数值和竖线
p1 = x2 + w1
p2 = y2 + w2 + h / 2
l1 = 0
l2 = 0
For k = 0 To N – 1
Printer.CurrentX = p1
Printer.CurrentY = p2
l1 = Printer.TextWidth(Trim(pp(k)))
l2 = Printer.TextWidth(Trim(v(k)))
If l1 >= l2 Then
p1 = p1 + l1 + 2 * w1
Else
p1 = p1 + l2 + 2 * w1
End If
Printer.Print v(k)
Printer.Line (p1 – w1, y2 + h)-(p1 – w1, y2 + h / 2)
Next k
' 打印最后一条横线
Printer.Line (p1 – w1, y2 + h)-(x2, y2 + h)
Adodc1.Recordset.MoveNext
c = c + 1
yy = (Printer.ScaleHeight / 6) * (c Mod 6)
Loop
'结束打印
Printer.EndDoc
Exit Sub
'ConnectionERR:
' '错误处理程序
' MsgBox "数据库连接错误," & Err.Description, vbCritical, "出错"
' Exit Sub
'RecordSetERR:
' MsgBox "RecordSet生成错误," & Err.Description, vbCritical, "错误"
' Exit Sub
PrintERR:
MsgBox "打印错误," & Err.Description, vbCritical, "出错"
End Sub
如发现本站有涉嫌抄袭侵权/违法违规等内容,请<举报!一经查实,本站将立刻删除。