这是我很早以前编的一段代码
不过比较麻烦。
On Error Resume Next
Xb = InputBox("请输入标题:", "标题", "年月转资项目")
CommonDialog1.ShowPrinter
Dim aaa
Dim i As Integer
'Dim love As String
Fpoint = Num2 '记录每页打印的起始横坐标
begin:
Printer.Font.Size = 9 '字体
'*************************************************
'* 从第一个字段开始打印,分页打印 *
'*************************************************
Data2.RecordSource = "select*from pa1"
Data2.Refresh
Data2.Recordset.MoveFirst
i = 1
While Not Data2.Recordset.EOF
aaa = Data2.Recordset.Fields(0)
Set rec = db.OpenRecordset("select [" & aaa & "] from love ") '从第一个字段开始
rec.MoveFirst ' 到最后一个字段
While IsNull(rec(0))
rec.MoveNext
Wend
Num1 = Num2
Printer.CurrentX = Num1
love = rec(0)
Do Until rec.EOF
If IsNull(rec(0)) Then
GoTo e
ElseIf Len(CStr(rec(0))) > Len(CStr(love)) Then
love = rec(0)
End If '选取最长字段的内容
e: '按其标准画线
rec.MoveNext
Loop
If Len(aaa) > Len(CStr(love)) Then 'this place is
love = aaa
End If
If VarType(love) <> vbString Then '判断是否为有效数值
love = Format(love, "fixed")
cd = Len(CStr(love))
End If
Num2 = Num2 + Printer.TextWidth(love) + 300
'Else:
' cd = Len(CStr(aaa)) * 2
' Num1 = Num2
' Num2 = Num2 + Printer.TextWidth(aaa) + 250
' Printer.CurrentX = Num1
'End If '如果字段长度不为0,则打印下一个字段,否....打印下一个字段
rec.MoveFirst
Printer.CurrentY = 2500
Printer.Print "|"; Data2.Recordset.Fields(0) '打印标题
Printer.Line (Num1 - 40, Printer.CurrentY + 30)-(Num2, Printer.CurrentY + 30)
Printer.CurrentX = Num1 '当前打印的横坐标
Printer.CurrentY = Printer.CurrentY + 50
'Printer.Font.Size = 12 '字体
love = ""
While Not rec.EOF
If Len(rec(0)) <> 0 Then '是否为空Null
If VarType(rec(0)) <> vbString Then '如果为数值型,则右对齐
Printer.Print "|";
For ii = 0 To cd - Len(CStr(Format(rec(0), "fixed")))
Printer.Print " ";
Next
Printer.Print Format(rec(0), "fixed")
Printer.CurrentX = Num1 '当前打印的横坐标
Else
Printer.Print "|"; rec(0) '如果为字符型,则左对弃
End If
Else: Printer.Print "|"; " "
End If
Printer.Line (Num1, Printer.CurrentY + 30)-(Num2, Printer.CurrentY + 30)
Printer.CurrentX = Num1 '当前打印的横坐标
Printer.CurrentY = Printer.CurrentY + 50
If i = j Then '如果是最后一个字段,则把打印过的记录删除
rec.Delete
End If
If Printer.CurrentY >= Printer.ScaleHeight * 97 / 100 Then
GoTo Moven
End If
rec.MoveNext
Wend '打印当前字段的所有记录
Moven:
Y = Printer.CurrentY
i = i + 1
Data2.Recordset.MoveNext
Wend
'画线
Printer.Line (Num2, 2500)-(Num2, Y)
Printer.Line (800, 2400)-(Num2, 2400)
Printer.Font.Size = 12
Printer.CurrentX = Printer.ScaleWidth * 2 / 5
Printer.CurrentY = 1500
Printer.Print Xb
If Not rec.EOF Then
Printer.NewPage
Num2 = Fpoint
GoTo begin
End If
Printer.EndDoc
Num2 = 0
Num1 = 0
F1.Visible = False