急求：票据打印实现的代码（高分赠送）

Question

怎么实现票据打印啊？最好有代码

Answer 1

最好自己用PRINTER写一个...因为票据打印是套打的..而且,格式又是固定的.

Answer 2

这是我某个程序中的例子.
你可能看得很乱..Option ExplicitDim PrintArray() As String '定义一个动态数组,用于打印输出
Dim ArrayID As Long
Dim PagePrintX As Long '每页纸横向可打印的数量
Dim PagePrintY As Long '每页纸纵向可打印的数量
Dim PageMax As Long    '每页纸全部的数量
Dim PMax As Long       '共要打印的
Dim DltX(1) As Long       '横向间距
Dim DltY As Long       '纵向间距
Dim PrintFlag As Boolean
Dim ImageLT(3, 1) As Long
Dim SelPrint As Long
Dim ItemNum As Long
Dim FormX As Long, FormY As Long
Dim UnloadFlag As BooleanSub StarToPrint(SId As Long, Eid As Long) '开始打印 [纸页码,不是项数]
  Dim StarID As Long
  Dim SlooP As Long
  Dim ElooP As Long
  Dim LeftX As Long, RightX As Long '左右边距
  Dim TopT As Long '1/2顶距
  Dim SumX As Long
  Dim SumY As Long
  Dim TmpX As Long
  Dim TmpY As Long
  Dim StMod As Long
  
  SlooP = (SId - 1) * 6 + 1: ElooP = Eid * 6
  For StarID = SlooP To ElooP
      StMod = StarID Mod 6
      If PrintFlag Then UnloadFlag = True: Printer.KillDoc: Exit Sub
      Label8.Caption = "已发送第" & (StarID + 5) \ 6 & "页"
      If (StarID Mod 2) = 0 Then '右边
          SumY = (Picture3.Height + DltY) * (((StarID - 1) Mod 6) \ 2) + 567
          SumX = DltX(1)
      Else '左边
          SumY = (Picture3.Height + DltY) * ((StMod - 1) \ 2) + 567
          SumX = DltX(0)
      End If
      Call StarPage(StarID - 1): DoEvents
      Call PrintPage(StarID - 1, SumX, SumY): DoEvents
      If StMod = 0 Then Printer.NewPage: DoEvents
      If StarID = ElooP Then Printer.EndDoc: DoEvents
  Next StarID
PrintEnd:
  Call StarPage(0)
End SubPrivate Sub Form_Load()
  Dim a As Long, B As Long
  Me.Hide: PrintFlag = False
  SelPrint = 0: UnloadFlag = True
  B = Image2.Count - 1
  For a = 0 To B
      ImageLT(a, 0) = Image2(a).Left
      ImageLT(a, 1) = Image2(a).Top
  Next a
  Call SetFrmBackPic: DoEvents
  Call TelToArray
  Call StarPage(0)
End SubSub SetFrmBackPic() '设置平埔背景
    Dim FrmW As Long, FrmH As Long
    Dim PicW As Long, PicH As Long
    Dim LoopW As Long, LoopH As Long
    Dim X As Long, Y As Long
    FrmW = Me.Width: FrmH = Me.Height
    PicW = BackPic.Width: PicH = BackPic.Height
    LoopW = (FrmW + PicW - 1) \ PicW: LoopH = (FrmH + PicW - 1) \ PicH
    PrintFrm.AutoRedraw = True
    For X = 0 To LoopW
        For Y = 0 To LoopH
            PrintFrm.PaintPicture BackPic.Picture, X * PicW, Y * PicH, PicW, PicH, _
                                  0, 0, PicW, PicH
        Next Y
    Next X
    PrintFrm.AutoRedraw = False
End SubSub TelToArray() '将要打印的内容输入到一个动态数组中
    Dim RowMax As Long, ColMax As Long
    Dim LoopRow As Long, LoopCol As Long
    Dim TmpStr As String
    Dim TmpPw As Long, TmpPh As Long
    Dim Amod As Long
    Dim DltWidth As Single
    Dim TmpW As Long
    Dim pWidth As Long
    Dim OleTmp As Long
    Dim ValMax As Long
        
    ArrayID = 0: ValMax = 50
    Oscoll.Show: Oscoll.Label3.Caption = "数据在处理中,请稍等...": DoEvents
    If FindFlag Then
       If FindExcel Then
          With PhoFrm.MSHFlexGrid1(1)
          .Redraw = False: .Visible = False
          pWidth = Oscoll.Picture1.Width
          RowMax = .Rows - 1: ColMax = 17
          DltWidth = pWidth / ValMax
          ReDim PrintArray(16, 4)
          For LoopRow = 1 To RowMax
              TmpStr = .TextMatrix(LoopRow, 1)
              If Len(TmpStr) > 0 Then
                 ArrayID = ArrayID + 1
                 ReDim Preserve PrintArray(16, ArrayID)
                 For LoopCol = 1 To ColMax
                     PrintArray(LoopCol - 1, ArrayID - 1) = .TextMatrix(LoopRow, LoopCol)
                 Next LoopCol
              End If
              TmpW = (LoopRow * ValMax) \ RowMax
              If TmpW - OleTmp > 0 Then
                 Oscoll.Shape1.Width = TmpW * DltWidth
                 Oscoll.Label2.Caption = (2 * TmpW) & "%"
                 OleTmp = TmpW
              End If
          Next LoopRow
          .Visible = True: .Redraw = True
          End With
       End If
    Else
       With PhoFrm.MSHFlexGrid1(0)
          .Redraw = False: .Visible = False
          pWidth = Oscoll.Picture1.Width
          RowMax = .Rows - 1: ColMax = 17
          DltWidth = pWidth / ValMax
          ReDim PrintArray(16, 1)
          For LoopRow = 1 To RowMax
              TmpStr = .TextMatrix(LoopRow, 1)
              If Len(TmpStr) > 0 Then
                 ArrayID = ArrayID + 1
                 ReDim Preserve PrintArray(16, ArrayID)
                 For LoopCol = 1 To ColMax
                     PrintArray(LoopCol - 1, ArrayID - 1) = .TextMatrix(LoopRow, LoopCol)
                 Next LoopCol
              End If
              TmpW = (LoopRow * ValMax) \ RowMax
              If TmpW - OleTmp > 0 Then
                 Oscoll.Shape1.Width = TmpW * DltWidth
                 Oscoll.Label2.Caption = (2 * TmpW) & "%"
                 OleTmp = TmpW
              End If
          Next LoopRow
          .Visible = True: .Redraw = True
       End With
    End If
    Amod = ArrayID Mod 6
    If CBool(Amod) Then
       ArrayID = ArrayID + 6 - Amod
       ReDim Preserve PrintArray(16, ArrayID)
    End If
    TmpPw = 2: TmpPh = 3
    PagePrintX = TmpPw: PagePrintY = TmpPh
    PageMax = TmpPw * TmpPh
    PMax = ArrayID '下标从1开始
    '打印机设置---------------------------------
    Printer.Orientation = vbPRORPortrait '1 纵向  2 横向
    Printer.PrintQuality = vbPRPQHigh    '高质量打印
    Printer.PaperSize = vbPRPSA4         '设置为A4纸
    Printer.ScaleLeft = 0: Printer.ScaleTop = 0
    Printer.ScaleWidth = Printer.Width
    Printer.ScaleHeight = Printer.Height
    '-------------------------------------------
    DltX(0) = (Printer.Width - 2 * Picture3.Width - 450) / 2
    DltX(1) = DltX(0) + 567 + Picture3.Width
    DltY = (Printer.Height - PagePrintY * Picture3.Height) \ PagePrintY
    Label2.Caption = "共" & (PMax + 5) \ 6 & "页"
    Unload Oscoll: PrintFrm.Show: DoEvents
    Set Oscoll = Nothing
End Sub

Answer 3

Sub StarPage(Index As Long) '显示打印内容
    Dim LoopRow As Long
    Dim LoopCol As Long
    Dim Pid As Long
    For Pid = 0 To 16
        Label3(Pid).Caption = PrintArray(Pid, Index)
   Next Pid
   PageNumLab.Caption = "-" & (Index + 1) & "-"
End SubSub PrintPage(Index As Long, X As Long, Y As Long)  '打印
    Dim a As Long
    Dim B As Long
    B = Line1.Count - 1
    For a = 0 To B
        If a <= 16 Then
           Printer.CurrentX = X + Label1(a).Left '标题
           Printer.CurrentY = Y + Label1(a).Top
           Printer.Print Label1(a).Caption
           Printer.CurrentX = X + Label3(a).Left '内容
           Printer.CurrentY = Y + Label3(a).Top
           Printer.Print Label3(a).Caption
        End If
        Printer.Line (Line1(a).X1 + X, Line1(a).Y1 + Y)-(Line1(a).X2 + X, Line1(a).Y2 + Y) '划线
    Next a
    PageNumLab.Caption = "-" & (Index + 1) & "-"
    Printer.CurrentX = X + PageNumLab.Left '内容
    Printer.CurrentY = Y + PageNumLab.Top
    Printer.Print PageNumLab.Caption
    Printer.Line (X, PageNumLab.Top + PageNumLab.Height + DltY * 2 / 3 + Y)- _
                 (Picture3.Width + X, PageNumLab.Top + PageNumLab.Height + DltY * 2 / 3 + Y) '划线
End SubPrivate Sub Image2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Image2(Index).Top = ImageLT(Index, 1) + 9
End SubPrivate Sub Image2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim SelStr As String
  Dim PPmax As Long
  Dim PIDA As Long, PIDB As Long
  Image2(Index).Top = ImageLT(Index, 1)
  On Error Resume Next
  PPmax = (PMax + 5) \ 6
  SelStr = Image2(Index).Tag
  Select Case SelStr
         Case Is = "打印"
              If PPmax = 0 Then Exit Sub
              PrintFlag = False: UnloadFlag = False
              Select Case SelPrint
                     Case Is = "0" '全部
                          PIDA = 1: PIDB = PPmax
                          Call StarToPrint(PIDA, PIDB)
                     Case Is = "1" '范围
                          PIDA = 0: PIDB = 0
                          PIDA = CInt("0" & Trim(Text1.Text))
                          PIDB = CInt("0" & Trim(Text2.Text))
                          If PIDA = 0 And PIDB > 0 Then PIDA = PIDB
                          If PIDB = 0 And PIDA > 0 Then PIDB = PIDA
                          If PIDA > PIDB Then
                             Dim Tmp As Long
                             Tmp = PIDB: PIDB = PIDA: PIDA = Tmp
                          End If
                          If PIDA > PPmax Or PIDB > PPmax Or _
                             PIDA < 0 Or PIDB < 0 Then
                             Err.Number = 1
                          End If
                          If Err.Number <> 0 Then
                             MyMsgBox "请输入正确的页码范围!", 1 + 8192, "通信录打印"
                          Else
                             Call StarToPrint(PIDA, PIDB)
                          End If
              End Select
         Case Is = "取消"
              PrintFlag = True
         Case Is = "退出"
              UnloadFlag = True
              PrintFlag = True
              Screen.MousePointer = 11
              Timer1.Enabled = True
  End Select
End SubPrivate Sub Label14_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
     FormX = X: FormY = Y
  End If
End Sub
Private Sub Label14_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
     Me.Move Me.Left - FormX + X, Me.Top - FormY + Y
     DoEvents
  End If
End SubPrivate Sub Label15_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
     FormX = X: FormY = Y
  End If
End SubPrivate Sub Label15_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
     Me.Move Me.Left - FormX + X, Me.Top - FormY + Y
     DoEvents
  End If
End SubPrivate Sub Option1_Click(Index As Integer)
  SelPrint = Index
  Command1.SetFocus
  Text1.Enabled = Option1(1).Value
  Text2.Enabled = Option1(1).Value
End SubPrivate Sub Option1_GotFocus(Index As Integer)
  Command1.SetFocus
End SubPrivate Sub Timer1_Timer()
  If UnloadFlag Then
     Timer1.Enabled = False
     PhoFrm.Enabled = True
     PhoFrm.SetFocus: DoEvents
     Erase PrintArray
     Screen.MousePointer = 0
     Unload PrintFrm
     Set PrintFrm = Nothing
     Exit Sub
  End If
End Sub

Answer 4

这个是主体...
Sub PrintPage(Index As Long, X As Long, Y As Long)  '打印
    Dim a As Long
    Dim B As Long
    B = Line1.Count - 1
    For a = 0 To B
        If a <= 16 Then
           Printer.CurrentX = X + Label1(a).Left '标题
           Printer.CurrentY = Y + Label1(a).Top
           Printer.Print Label1(a).Caption
           Printer.CurrentX = X + Label3(a).Left '内容
           Printer.CurrentY = Y + Label3(a).Top
           Printer.Print Label3(a).Caption
        End If
        Printer.Line (Line1(a).X1 + X, Line1(a).Y1 + Y)-(Line1(a).X2 + X, Line1(a).Y2 + Y) '划线
    Next a
    PageNumLab.Caption = "-" & (Index + 1) & "-"
    Printer.CurrentX = X + PageNumLab.Left '内容
    Printer.CurrentY = Y + PageNumLab.Top
    Printer.Print PageNumLab.Caption
    Printer.Line (X, PageNumLab.Top + PageNumLab.Height + DltY * 2 / 3 + Y)- _
                 (Picture3.Width + X, PageNumLab.Top + PageNumLab.Height + DltY * 2 / 3 + Y) '划线
End SubPrivate Sub Image2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  Image2(Index).Top = ImageLT(Index, 1) + 9
End Sub

Answer 5

谢谢各位，特别是MSTOP(陈建华(东莞立晨企业资讯服务有限公司)) 的慷慨