如何控制打印机，打印完不换页，并且可以变换打印字体大小

Question

用printer对象就可以呀！
它可以设置不换页，改变是什么字体等等，
功能强大呢！

Answer 1

Printer.FontName = "宋体"           '设置打印字体
    Printer.FontSize = "9"              '设置打印字号
    PrintData = ""                      '打印内容清空
            Printer.CurrentX = PrnX
            Printer.CurrentY = PrnY
            
            Printer.Print PrintData     '打印数据
            Printer.EndDoc              '打印结束标志，可用于控制换页

Answer 2

用了Printer.EndDoc 就会换页啊

Answer 3

不用Printer.EndDoc和printer.newpage就会一直不换页
Printer.FontSize 设置字体大小

Answer 4

可是不用Printer.EndDoc，打印机就不会打

Answer 5

Public Sub leavecard_print()
  If MsgBox("打印出门证？", vbQuestion + vbOKCancel, "提示") = vbOK Then
    Dim yy As String
    Dim mm As String
    Dim dd As String
    Dim fpath As String
    On Error GoTo mylable
    mydoc.Close
    appwd.Quit
mylable:
    Call del_doc
    yy = Year(CDate(RTrim(T_date.Text)))
    mm = Month(CDate(RTrim(T_date.Text)))
    dd = Day(CDate(RTrim(T_date.Text)))
        Dim pini As String
        Dim df_Y As Integer
        Dim df_X As Integer
        pini = ReadWriteINI("get", App.Path + "\print.ini", "票据打印设置", "WIN98")
        If RTrim(pini) = "1" Then  'app in  win98
          df_Y = 0
          df_X = 0
        Else                 'app in win2000
           df_Y = CInt(ReadWriteINI("get", App.Path + "\print.ini", "票据打印设置", "Y矫正值"))
           df_X = CInt(ReadWriteINI("get", App.Path + "\print.ini", "票据打印设置", "X矫正值"))
        End If
            Printer.CurrentX = 0
            Printer.CurrentY = 0
            Printer.Font.name = "宋体"
            Printer.Font.Size = 14
            Printer.CurrentY = Printer.CurrentY + 550 + df_Y
            Printer.CurrentX = 2400 + df_X
            Printer.Print "绍兴鼎峰水泥有限公司" '公司名称
            Printer.Font.name = "宋体"
            Printer.Font.Size = 11
            Printer.CurrentY = 1170 + df_Y
            Printer.CurrentX = 2300 + df_X
            Printer.Print yy + "     " + mm + "    " + dd '年月日
            Printer.CurrentY = 1638 + df_Y
            Printer.CurrentX = 2400 + df_X
            Printer.Print Cb_comp.Text  '提货单位
            Printer.CurrentY = 1638 + df_Y
            Printer.CurrentX = 7900 + df_X
            Printer.Print T_link_man.Text '提货人
            Printer.CurrentY = 2308 + df_Y
            Printer.CurrentX = 2400 + df_X
            Printer.Print "普通水泥/" + T_degree.Text   '强度等级
            Printer.CurrentY = 2308 + df_Y
            Printer.CurrentX = 5200 + df_X
            Printer.Print T_breed_code.Text  '水泥编号
            Printer.CurrentY = 2308 + df_Y
            Printer.CurrentX = 8000 + df_X
            Printer.Print T_store_name.Text    '仓位号
            Printer.CurrentY = 2938 + df_Y
            Printer.CurrentX = 2800 + df_X
            Printer.Print T_bill_number.Text '提货单号
            Printer.CurrentY = 2938 + df_Y
            Printer.CurrentX = 7500 + df_X
            Printer.Print T_amount.Text + "  吨" '提货数量
            Printer.CurrentY = 3608 + df_Y '4308
            Printer.CurrentX = 2800 + df_X
            Printer.Print T_vehi_comp.Text '承运单位
            Printer.CurrentY = 3608 + df_Y
            Printer.CurrentX = 7500 + df_X
            Printer.Print T_vehi_tool.Text  '运输工具
            Printer.CurrentY = 4908 + df_Y '6208
            Printer.CurrentX = 7800 + df_X
            Printer.Print Cb_makeout_man.Text '开单人
            Printer.EndDoc
        Call Sleep(4000)
        GoTo mylab0
mylab0:
        On Error GoTo mylab1
        Open "LPT1:" For Output As #1
        For i = 0 To 16
            Print #1, ""
        Next
       Close #1
      Exit Sub
mylab1:
  Err.Clear
  Call Sleep(4000)
  GoTo mylab0
 End If
End Sub只要把走纸控制好，就行了...

Answer 6

Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As LongFunction ReadWriteINI(Mode As String, FileName As String, tmpSecname As String, Optional tmpKeyname As String, Optional tmpKeyValue) As String
Dim tmpString As String
Dim secname As String
Dim keyname As String
Dim keyvalue As String
Dim anInt
Dim defaultkey As StringOn Error GoTo ReadWriteINIError
If IsNull(Mode) Or Len(Mode) = 0 Then
  ReadWriteINI = "MODE ERROR "
  Exit Function
End If
If Len(FileName) = 0 Then
  ReadWriteINI = "FileName ERROR "
  Exit Function
End If
If IsNull(tmpSecname) Or Len(tmpSecname) = 0 Then
  ReadWriteINI = "Secname ERROR "
  Exit Function
End If
If IsNull(tmpKeyname) Or Len(tmpKeyname) = 0 Then
  ReadWriteINI = "Keyname ERROR "
  Exit Function
End If' WRITE MODE
  If UCase(Mode) = "WRITE" Then
      If IsNull(tmpKeyValue) Or Len(tmpKeyValue) = 0 Then
        ReadWriteINI = "ERROR KeyValue"
        Exit Function
      Else
        secname = tmpSecname
        keyname = tmpKeyname
        keyvalue = tmpKeyValue
        anInt = WritePrivateProfileString(secname, keyname, keyvalue, FileName)
      End If
  End If
  ' READ MODE
  If UCase(Mode) = "GET" Then
  
      secname = tmpSecname
      keyname = tmpKeyname
      defaultkey = "Failed"
      keyvalue = String$(50, 32)
      anInt = GetPrivateProfileString(secname, keyname, defaultkey, keyvalue, Len(keyvalue), FileName)
      If Left(keyvalue, 6) <> "Failed" Then
         tmpString = keyvalue
         tmpString = RTrim(tmpString)
         tmpString = Left(tmpString, Len(tmpString) - 1)
      End If
      ReadWriteINI = tmpString
  End If
Exit Function
ReadWriteINIError:
   MsgBox Error
   Stop
End Function

Answer 7

楼上的程序，我还是没搞定，能否拷一段完整的打印不换页程序与我，在此我先付款了，谢谢！
             [email protected]