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
