vba 任意自定义纸张大小、任意位置打印，精确到0.1毫米

使用超简单，可能word、execl等VBA环境使用，目的就是调整方便【功能很多，可以看注释，要熟练使用至少要熟悉C For Window或window API ,了解DC。不在线，别问初级问题，直接拿来用就好。有bug可以留言，可能回复！】

（打印样张，A4纸横放，这是打印到屏幕的效果）

dim oPrinter as new clsPrintCustomPageSize

‘开始打印，返回打印机DC（或用PrinterDC()取)

oPrinter.PrinterBegin "打印机名称（或display）","纸张名称"，“纸张方向”，“纸张宽度”，“纸张长度”

’打印文字

用  oPrinter.PrinterTextOut 或 PrinterExtTextOut 或 PrinterDrawText 打印各种文字

'PrinterTextOut--在指定坐标打印
'PrinterExtTextOut--在指定坐标打印，可以指定字间距
'PrinterDrawText--在指定区域打印，可以自动换行、对齐、居中（垂直、水平）
打印图形或图像，直接API，此类给出DC

‘换新页，支持多页打印

 PrinterNewPage

‘结束打印，打印输出。display输出一个stdPicture对象，可以显示或存成图像

oPrinter.PrinterEnd

'--------------------------------------------------------------------
'以下是新手使用，PrinterBegin打开打印机，PrinterTextOut打印，PrinterEnd关闭打印机，打印机输出
'所有X，Y坐标均为毫米，精确到0.1毫米,字体大小为磅，与word、execl等一致且设备无关
'区别：
'PrinterTextOut--在指定坐标打印
'PrinterExtTextOut--在指定坐标打印，可以指定字间距
'PrinterDrawText--在指定区域打印，可以自动换行、对齐、居中
'以上三个函数效率从高到低
'--------------------------------------------------------------------

 代码放到：clsPrintCustomPageSize.cls(类）中，演示代码才能正常使用。放普通bas中，也可以，但要注意冲突！放class中，可以减少总之。每个类的实例可以操纵一台打印机，放入bas只能使用一台打印机。

'演示内容
Sub tt()
    Dim pictPrn  As StdPicture, oprint As New clsPrintCustomPageSize
    Dim iI As Long
    With oprint
        .PrinterBegin "display", "A4", vbPRORLandscape
        For iI = 0 To 30
            .PrinterDrawBox 10 * iI, 0, 10 * (iI + 1), 10, 2
            .PrinterTextOut 10 * iI + 1, 1, Format(iI, "00"), vbRed, 24
        Next
        For iI = 1 To 30
            .PrinterDrawBox 0, 10 * iI, 10, 10 * (iI + 1), 4
            .PrinterTextOut 1, 10 * iI + 1, Format(iI, "00"), vbRed, 24
        Next

         .PrinterDrawBox 10, 10, 20, 20, 10
         .PrinterTextOut 10, 10, "我", vbRed, 28.3
         iI = Val(Split(.PrinterCalcRect("A", 28.3), vbTab)(3))
         .PrinterDrawBox 10, 10, 10 + iI, 10 + iI, 1, vbRed

        Set pictPrn = .PrinterEnd
    End With
    If Not pictPrn Is Nothing Then
        If Not pictPrn.Handle = 0 Then
    '        frmPreview.imgPrnt.Picture = pictPrn
    '        frmPreview.Show 0
            SavePicture pictPrn, Environ("temp") + "\1.bmp"
            Call ShellExecute(ByVal 0, "open", Environ("temp") + "\1.bmp", ByVal 0, ByVal 0, 2)
        End If
    Else
        If Not Dir("E:\文档\Desktop\*.oxps") = "" Then
            Call ShellExecute(ByVal 0, "open", "E:\文档\Desktop\" & Dir("E:\文档\Desktop\*.oxps"), ByVal 0, ByVal 0, 2)
        End If
    End If
End Sub

使用注意

1、字体单位: 磅(与word等一致，方便使用。) 设备无关

2、打印时X，Y及纸张大小定义，单位均为毫米，精确到0.1

3、可能直接操纵打印机DC，单位还是0.1毫米，支持所有DC相关API，仅对高手使用