VB打印程序
有一个固定的表格,然后我想用VB编辑个程序输入数据,数据输入完成后将输入的数据打印在固定的表格上。那位大神有时间愿意指导指导小弟的谢谢了!!!我的联系方式254765767@
Public Sub 打印预览(fr As 打印预览) On Error Resume Next fr.Picture3.Cls 'Printer.Orientation = vbPRORPortrait '纵向 打印机纸方向 = vbPRORPortrait Call fr.setpage '设置纸大小 Call viewdate(fr.Picture3, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米) '固定部分 Call fr.SETDATAFR(Me) '告诉预览窗体是从哪个窗体调用过来的,以便提供打印功能调用 Call 显示结果(fr.Picture3, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米) '套打部分 fr.Show End Sub Public Sub 打印() On Error Resume Next If 注册否 Then If 打印机存在 Then Printer.Orientation = vbPRORPortrait '纵向 Call viewdate(Printer, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米) '固定部分 Call 显示结果(Printer, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米) '套打部分 Printer.EndDoc Else MsgBox "错误:未发现打印机,无法打印!", vbCritical, 程序标题 End If Else MsgBox "警告:未注册用户不能打印!", vbInformation, 程序标题 End If End Sub Private Sub 显示结果(pp As Object, lefts As Long, tops As Long) On Error Resume Next '------显示建议卡动态部分------- Dim i As Long Dim fj() As String For i = 0 To UBound(数据内容) 'If Len(数据内容(i)) > 0 Then fj = Split(DateS(i), ",") '分解 fj(4) = 数据内容(i) '置换内容 DateS(i) = Join(fj(), ",") '重新连接起来 'End If Call viewtext(DateS(i), pp, lefts, tops) '调用显示 Next i End Sub Public Sub viewdate(pp As Object, lefts As Long, tops As Long) '画线及显示固定部分 On Error Resume Next Dim i As Long Dim fj() As String Dim vx As Long, vy As Long Dim Fx As Long, Fy As Long Dim hx As Long, hy As Long '--------显示固定文字部分----------- For i = 0 To UBound(FixedS) If Len(FixedS(i)) > 5 Then Call viewtext(FixedS(i), pp, lefts, tops) End If Next i '---------画线---------- For i = 0 To UBound(LineS) If Len(LineS(i)) > 5 Then fj = Split(LineS(i), ",") If UBound(fj) > 2 Then pp.Line (lefts + fj(0), tops + fj(1))-(lefts + fj(2), tops + fj(3)), 0 End If End If Next i End Sub
Private Sub viewtext(cs As String, obj As Object, lefts As Long, tops As Long) '传进来的数据格式为: X1,Y1,X2,Y2,显示内容,[字体[,字号]] '字体为可选,字号也为可选,如果需要指定字号,就必须指定字体 On Error Resume Next Dim fj() As String Dim vx As Long, vy As Long Dim Fx As Long, Fy As Long Dim hx As Long, hy As Long fj = Split(cs, ",") '分解传进来的参数 If UBound(fj) > 4 Then '有字体设置 If Len(fj(5)) > 0 Then '字体名不为空 obj.FontName = fj(5) End If Else obj.FontName = "宋体" '默认为宋体 End If If UBound(fj) > 5 Then '有字号设置 If Val(fj(6)) > 2 Then '字号最小不得小于2 obj.FontSize = fj(6) End If Else obj.FontSize = 字体大小 End If Fy = obj.TextHeight(fj(4)) '字体高 Fx = obj.TextWidth(fj(4)) '字体宽 hx = Val(fj(2)) - Val(fj(0)) '有效宽 hy = Val(fj(3)) - Val(fj(1)) '有效高 vx = lefts + Val(fj(0)) + (hx - Fx) / 2 vy = tops + Val(fj(1)) + (hy - Fy) / 2 obj.CurrentX = vx obj.CurrentY = vy obj.Print fj(4) End Sub