Printer.PaperSize = vbPRPSA4
Printer.Orientation = vbPRORLandscape

Printer 对象常数  

打印机颜色模式  
常数 值 描述  
vbPRCMMonochrome 1 单色输出  
vbPRCMColor 2 彩色输出  

双面打印  
常数 值 描述  
vbPRDPSimplex 1 单面打印  
vbPRDPHorizontal 2 双面水平打印  
vbPRDPVertical 3 双面垂直打印  

打印方向  
常数 值 描述  
vbPRORPortrait 1 文档打印以纸的窄边作顶部  
vbPRORLandscape 2 文档打印以纸的宽边作顶部  

打印质量  
常数 值 描述  
vbPRPQDraft -1 草稿打印质量  
vbPRPQLow -2 低级打印质量  
vbPRPQMedium -3 中等打印质量  
vbPRPQHigh -4 高级打印质量  

PaperBin 属性  
常数 值 描述  
vbPRBNUpper 1 从上层纸盒进纸  
vbPRBNLower 2 从下层纸盒进纸  
vbPRBNMiddle 3 从中间纸盒进纸  
vbPRBNManual 4 等待手动插入每页纸  
vbPRBNEnvelope 5 从信封进纸器进纸  
vbPRBNEnvManual 6 从信封进纸器进纸；但要等待手动插入  
vbPRBNAuto 7 （缺省方式）从当前缺省纸盒进纸  
vbPRBNTractor 8 从拖拉进纸器供纸  
vbPRBNSmallFmt 9 从小型进纸器进纸  
vbPRBNLargeFmt 10 从大型纸盒进纸  
vbPRBNLargeCapacity 11 从大容量进纸器进纸  
vbPRBNCassette 14 从附加的卡式纸盒进纸  


PaperSize 属性  
常数 值 描述  
vbPRPSLetter 1 信笺， 8 1/2 x 11 英寸  
vbPRPSLetterSmall 2 +A611 小型信笺， 8 1/2 x 11 英寸  
vbPRPSTabloid 3 小型报， 11 x 17 英寸  
vbPRPSLedger 4 分类帐， 17 x 11 英寸  
vbPRPSLegal 5 法律文件， 8 1/2 x 14 英寸  
vbPRPSStatement 6 声明书，5 1/2 x 8 1/2 英寸  
vbPRPSExecutive 7 行政文件，7 1/2 x 10 1/2 英寸  
vbPRPSA3 8 A3, 297 x 420 mm  
vbPRPSA4 9 A4, 210 x 297 mm  
vbPRPSA4Small 10 A4小号， 210 x 297 mm  
vbPRPSA5 11 A5, 148 x 210 mm  
vbPRPSB4 12 B4, 250 x 354 mm  
vbPRPSB5 13 B5, 182 x 257 mm  
vbPRPSFolio 14 对开本， 8 1/2 x 13 英寸  
vbPRPSQuarto 15 四开本， 215 x 275 mm  
vbPRPS1&H14 16 10 x 14 英寸  
vbPRPS11x17 17 11 x 17 英寸  
vbPRPSNote 18 便条，8 1/2 x 11 英寸  
vbPRPSEnv9 19 #9 信封， 3 7/8 x 8 7/8 英寸  
vbPRPSEnv10 20 #10 信封， 4 1/8 x 9 1/2 英寸  
vbPRPSEnv11 21 #11 信封， 4 1/2 x 10 3/8 英寸  
vbPRPSEnv12 22 #12 信封， 4 1/2 x 11 英寸  
vbPRPSEnv14 23 #14 信封， 5 x 11 1/2 英寸  
vbPRPSCSheet 24 C 尺寸工作单  
vbPRPSDSheet 25 D 尺寸工作单  
vbPRPSESheet 26 E 尺寸工作单  
vbPRPSEnvDL 27 DL 型信封， 110 x 220 mm  
vbPRPSEnvC3 29 C3 型信封， 324 x 458 mm  
vbPRPSEnvC4 30 C4 型信封， 229 x 324 mm  
vbPRPSEnvC5 28 C5 型信封， 162 x 229 mm  
vbPRPSEnvC6 31 C6 型信封， 114 x 162 mm  
vbPRPSEnvC65 32 C65 型信封，114 x 229 mm  
vbPRPSEnvB4 33 B4 型信封， 250 x 353 mm  
vbPRPSEnvB5 34 B5 型信封，176 x 250 mm  
vbPRPSEnvB6 35 B6 型信封， 176 x 125 mm  
vbPRPSEnvItaly 36 信封， 110 x 230 mm  
vbPRPSEnvMonarch 37 信封大王， 3 7/8 x 7 1/2 英寸  
vbPRPSEnvPersonal 38 信封， 3 5/8 x 6 1/2 英寸  
vbPRPSFanfoldUS 39 U.S. 标准复写簿， 14 7/8 x 11 英寸  
vbPRPSFanfoldStdGerman 40 德国标准复写簿， 8 1/2 x 12 英寸  
vbPRPSFanfoldLglGerman 41 德国法律复写簿， 8 1/2 x 13 英寸  
vbPRPSUser 256 用户定义

[此贴子已经被作者于2018-4-23 11:41编辑过]

我的这个打印代码，你很可能看不懂。只找到这一个代码，以前写了一个简单的示例代码，弄丢了。

打印调用：

        If 打印机存在 Then
            Printer.Orientation = vbPRORPortrait                        '纵向
            
            Call viewdate(Printer, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米)
            Call 显示结果(Printer, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米)
            
            Printer.EndDoc          '单张纸，打印完就结束打印
        Else
            MsgBox "错误：未发现打印机，无法打印！", vbCritical, 程序标题
        End If

模拟显示调用：

    On Error Resume Next
'fr 是 打印预览的窗体名
    fr.Picture3.Cls
    Call fr.setpage               '设置纸大小
    Call viewdate(fr.Picture3, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米)
    
    Call fr.SETDATAFR(Me)
    
    Call 显示结果(fr.Picture3, 左边距2 * 缇转厘米, 上边距2 * 缇转厘米)
    
    fr.Show

有关函数

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
Dim m As String, n As String
Dim i As Long, j As Long, k As Long
Dim o As Long
Dim H() As String

    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))        '有效高
    
    If Fx > hx Or InStr(1, fj(4), "\") > 0 Then         '如果需要换行或人工指定的多多行
        
        If InStr(1, fj(4), "\") > 0 Then                '如果人工指定的多多行
            H = Split(fj(4), "\")                       '直接分解为每一行
            k = UBound(H)                '取行数
        Else
        
            k = Fx / hx          '计算需要分成多少行
            
            ReDim H(k)
            i = 0
            j = 1
            o = 1
            Do
                H(i) = Mid(fj(4), j, o)                     '一个字符一个字符的试下去
                If obj.TextWidth(H(i)) > hx - 100 Then      '试到撑满格子为止
                    j = j + o                               '本行结束,保存各变量
                    o = 1
                    i = i + 1
                Else
                    o = o + 1                               '本行未结束,长度加一,继续试下去
                End If
                
            Loop While j + o < Len(fj(4)) + 2           '<原来就 要加1，因为循环前是o+1，所以这里要再加1
        
        End If
        
        For i = 0 To k                          '处理每一行
       
            Fx = obj.TextWidth(H(i))            '字体宽
            vx = lefts + Val(fj(0)) + (hx - Fx) / 2
            vy = tops + Val(fj(1)) + (hy - Fy * (k + 1 + (k) * 0.2)) / 2 + Fy * (i) * 1.2           '行距为1.2,总高度为 行数*1+(行数-1)*0.2
            obj.CurrentX = vx
            obj.CurrentY = vy
            obj.Print H(i)
        
        Next i
    
    Else                    '没有多行,直接计算坐标显示
        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 If

    
End Sub

设置文件

谢谢！！！

Option Explicit
    Dim X As Long
    Dim y As Long
    Dim fnt As Variant
    Dim txt As String
    Dim dy As Variant
     
Public Function prnt(X As Variant, y As Variant, fnt As Variant, txt As Variant)
    Printer.CurrentX = X
    Printer.CurrentY = y
    Printer.FontSize = fnt
    Printer.Print txt
End Function
 
Private Sub Command1_Click()
    Printer.ScaleMode = 6 '以mm定位
    Printer.CurrentX = 10
    Printer.CurrentY = 20
    fnt = 12
    txt = "YD(0)"
    dy = prnt(X, y, fnt, txt)
    Printer.EndDoc
End Sub

你这个函数，定义，显示的内容和字号 建议反过来写
Public Function prnt(X As Variant, y As Variant, txt As Variant, Optional fnt As Variant = 12)
调用时最后二个参数也记得反过来。

Optional 这个关键 表示此后面的参数均为可选，
= 12     表示这个可选参数，如果没有传入时，默认使用这个值。

以下调用，都是使用我交换了参数位置的定义方式来调用。
   dy = prnt(X, y, txt ,fnt)       '显式传入字号
   dy = prnt(X, y, txt )           '不传入字号，使用默认的 12 磅的字
   dy = prnt(10,20,txt,12)         '一些参数直接写常数，一个参数使用变量
不需要返回值，也可以使用 call 来调用
   call prnt(X, y, txt ,fnt)       'call 调用
   prnt X, y, txt ,fnt             'call可以省略

----------
没有返回值的 过程，使用 sub 定义，
需有有返回值的过程，才使用 Function 定义，然后可以使用函数名返回一个结果。

这个代码是不是只能打一个，我就是想把窗体上的标签1的标题和标签2的标题和文本框的内容打出来打在一张纸的指定位置上，能不能用15楼的代码，代码越简单越好，打印的位置我自己调整

[此贴子已经被作者于2018-4-19 20:36编辑过]

Option Explicit

Dim XS As Long, YS As Long         '总体偏差
Dim XLEFT As Long, YTOP As Long     '页边距
'因程序代码简单，所以不考虑右边距和下边距

     
Public Sub prnt(X As Single, y As Single, txt As String, Optional fnt As Long = 12)
    Printer.CurrentX = X + XS + XLEFT       '打印位置，页边距+总体偏差+位置
    Printer.CurrentY = y + YS + YTOP
    Printer.FontSize = fnt
    Printer.Print txt
End Sub

Private Sub Command1_Click()

    Printer.ScaleMode = vbTwips     '单位为缇,窗体控件坐标也为缇，必须统一

    Call prnt(Label1.Left, Label1.Top, Label1.Caption, 12)
    Call prnt(Label2.Left, Label2.Top, Label2.Caption, 12)
    Call prnt(Text1.Left, Text1.Top, Text1.Text, 12)
   
    Printer.EndDoc
End Sub

Private Sub Form_Load()

    '初始化
    XS = 0 * 567            '这二个数据，应该是保存到配置文件里的，每次打印前再临时读取
    YS = 0 * 567            '配置文件里，这二个值的单位是厘米
   
    XLEFT = 2.5 * 567
    YTOP = 2.5 * 567       '页边距，与上面这边相同，可以固定为一个值，这里是固定为 2.5厘米

End Sub


未经测试。

谢谢，这个总体偏差是什么，不明白总体偏差xs ys有什么用，这xs ys都等于0？

[此贴子已经被作者于2018-4-20 22:50编辑过]

总体偏差是针对不同打印机装纸之间有偏差设置的。
这个值可以为正，也可以为负。
这个值应该可以让用户进行设置的。默认为零。

Public Sub prnt(X As Single, y As Single, txt As String, Optional fnt As Long = 12)
    Printer.CurrentX = X + XS + XLEFT       '打印位置，页边距+总体偏差+位置
    Printer.CurrentY = y + YS + YTOP
    Printer.FontSize = fnt
    Printer.Print txt
End Sub

这段代码是写在窗体里面还是模块里，还有页边距是不是可以去掉，直接写打印位置Printer.CurrentX = X 和Printer.CurrentY = y 不行吗