'*************************************************************************'功能:用Printer自制的表格的分栏打印
'调用:MyPrint(12, 2700)
'参数:Nz:脊背的总个数,pw:定义某个刻度下的表格宽度
'*************************************************************************
Sub MyPrint(Nz As Integer, pw As Integer)
    On Error Resume Next
    Dim MyStep, Steps, ps, h, np As Integer
    Printer.PaperSize = vbPRPSA4 'vbPRPSA4=210mm*297mm
    Printer.Orientation = 1 '    定义纸张为纵向打印1纵,2横
    BackColor = QBColor(7)
    Printer.Width = 11500 'A4纸56.7*210mm
    Printer.Height = 15800 '定义打印纸高度56.7*297mm
    Steps = pw + 100 '定义每个表格循环的步长
    np = Round(11500 / Steps)   '计算每页纸可以打印脊背的个数
    ph = 15800 '定义表格高度
    h = ph / 6 '定义5个内表格的高度
    np = np - 1
    k = 0 '统计循环个数
    
    '计算分页的数量
    If Nz Mod np = 0 Then
        ps = Round(Nz / np)
    Else
        ps = Round(Nz / np) + 1
    End If
 
    For j = 1 To ps
       '开始画大表格
       
       For i = 0 To np Step 1
            k = k + 1
            MyStep = Steps * i
            'V画第一条主横线
            Printer.Line (MyStep, 0)-(MyStep + pw, 0)
            
            '在第1条主横线和第2条割线之间打印档号
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = 300
            Printer.FontName = "黑体"
            Printer.FontSize = 12
            Printer.Print "档号"
            
            '在第2条割线与第3条割线之间打印档号对应的变量
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = h + 300
            Printer.FontName = "黑体"
            Printer.FontSize = 10
            Printer.Print "001001"
            
            '在第3条主横线和第4条割线之间打印总登记号
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = 2 * h + 300
            Printer.FontName = "黑体"
            Printer.FontSize = 12
            Printer.Print "总登记号"
            
            '在第4条割线与第5条割线之间打印总登记号对应的变量
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = 3 * h + 300
            Printer.FontName = "黑体"
            Printer.FontSize = 10
            Printer.Print "001001002"
            
            '在第5条主横线和第6条割线之间第二条主横线打印案卷题名
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = 4 * h + 300
            Printer.FontName = "黑体"
            Printer.FontSize = 12
            Printer.Print "案卷题名"
            
            '在第6条割线与第第二条主横线之间打印第二条主横线打印案卷题名对应的变量
            Printer.CurrentX = Steps * i + 100
            Printer.CurrentY = 5 * h + 300
            Printer.FontName = "黑体"
            Printer.FontSize = 10
            Printer.Print "湖南张家界"
            
            '在第一条主横线和第二条主横线之间再画5条分割线
            Printer.Line (MyStep, h)-(MyStep + pw, h)
            Printer.Line (MyStep, 2 * h)-(MyStep + pw, 2 * h)
            Printer.Line (MyStep, 3 * h)-(MyStep + pw, 3 * h)
            Printer.Line (MyStep, 4 * h)-(MyStep + pw, 4 * h)
            Printer.Line (MyStep, 5 * h)-(MyStep + pw, 5 * h)
            'V画第二条主横线
            Printer.Line (MyStep, ph)-(MyStep + pw, ph)
            'H画第一条竖线
            Printer.Line (MyStep, 0)-(MyStep, ph)
            'H画第二条竖线
            Printer.Line (MyStep + pw, 0)-(MyStep + pw, ph)
            
            If k = Nz Then Exit For '当循环个数等于脊背数量时退出FOR
        Next
        If k = Nz Then Exit For '当循环个数等于脊背数量时退出FOR
        Printer.NewPage '换页
    Next
          Printer.EndDoc
End Sub

解决方案 »

  1.   

    这样写下来累吧
    反复使用printer.*
    为什么不用
    With PrinterEnd With
      

  2.   

    现在 Printer.Print "湖南张家界湖南张家界" 由于表格宽度不够,打印出来字符就跑到表格外面于是我写了个将字符串按等宽的比列换行输出的函数
    '***********************************************************
    '函数:CutString(s,10)
    '功能:将字符串按等宽的比列换行输出
    '调用:CutString("123456789",3)
    '参数:Str:待截取的字符串,BrN:换行的字符个数
    '*************************************************************
    Function CutString(Str As String, BrN As Integer) As String
    Dim n As Integer
    Dim s1 As String
    Str = Str
    n = Len(Str)
    s1 = ""
    s2 = ""
    For i = 1 To n
        If i Mod BrN = 0 Then
            s1 = Left(Str, BrN)
            Str = Replace(Str, s1, "")
            s2 = s2 & Space(2) & s1 & Chr(10)
        End If
    Next
    CutString = s2
    End Function
    然后这样纵向输出打印, Printer.Print CutString("西安张家界双飞4日游全球", 1)
    不知道为什么打印预览的时候只要字符一超过12,整个页面就变乱了,谢谢指点,这个函数改如何修改
      

  3.   

    这样来搞定
    'str:要打印的字符串
    'x:每个要打印的字符串对应的x坐标
    'y: 每个要打印的字符串对应的y坐标的步长
    Private Sub CutPrint(str As String, x As Integer, y As Integer)
        Dim i As Integer
        Printer.FontSize = 12
        Printer.FontName = "黑体"
        For i = 1 To Len(str)
            Printer.CurrentX = x
            Printer.CurrentY = y * (i - 1)
            Printer.Print Mid(str, i, 1)
        Next
    End Sub
    Private Sub Command1_Click()
    Call CutPrint("ABCDE", 0, 200)
    Call CutPrint("abcde", 1200, 200)
    Call CutPrint("12345", 2400, 200)
    Printer.EndDoc输出结果:
    A   a   1
    B   b   2
    C   c   3
    D   d   4
    E   e   5