设置打印纸张大小

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
免费的学习交流网站，欢迎大家访问！
http://www.j2soft.cn/

Option ExplicitPrivate Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" (ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, ByVal cbBuf As Long, ByRef pcbNeeded As Long, ByRef pcReturned As Long) As Long
Private Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As Long
Private Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" (ByVal hPrinter As Long, ByVal pFormName As String) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) As Long
Private Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" (ByVal hdc As Long, lpInitData As Any) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" (ByVal lpString1 As String, ByRef lpString2 As Long) As Long'Constants for DEVMODE
Private Const CCHFORMNAME = 32
Private Const CCHDEVICENAME = 32
Private Const DM_FORMNAME As Long = &H10000
Private Const DM_ORIENTATION = &H1&'Constants for PRINTER_DEFAULTS.DesiredAccess
Private Const PRINTER_ALL_ACCESS = &HF0000 Or &H8 Or &H4

'Constants for DocumentProperties() call
Private Const DM_MODIFY = 8
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_COPY = 2
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_PAPERLENGTH = &H4&'Custom constants for this sample's SetPaperSize function
Private Const FORM_NOT_SELECTED = 0
Private Const FORM_SELECTED = 1
Private Const FORM_ADDED = 2Private Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate Type SIZEL
        cx As Long
        cy As Long
End TypePrivate Type SECURITY_DESCRIPTOR
        Revision As Byte
        Sbz1 As Byte
        Control As Long
        Owner As Long
        Group As Long
        Sacl As Long
        Dacl As Long
End Type'The two definitions for FORM_INFO_1 make the coding easier.
Private Type FORM_INFO_1
        Flags As Long
        pName As Long   ' String
        Size As SIZEL
        ImageableArea As RECTL
End TypePrivate Type sFORM_INFO_1
        Flags As Long
        pName As String
        Size As SIZEL
        ImageableArea As RECTL
End TypePrivate Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer
        dmFormName As String * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End TypePrivate Type PRINTER_DEFAULTS
        pDatatype As String
        pDevMode As Long    ' DEVMODE
        DesiredAccess As Long
End TypePrivate Type PRINTER_INFO_2
        pServerName As String
        pPrinterName As String
        pShareName As String
        pPortName As String
        pDriverName As String
        pComment As String
        pLocation As String
        pDevMode As DEVMODE
        pSepFile As String
        pPrintProcessor As String
        pDatatype As String
        pParameters As String
        pSecurityDescriptor As SECURITY_DESCRIPTOR
        Attributes As Long
        Priority As Long
        DefaultPriority As Long
        StartTime As Long
        UntilTime As Long
        Status As Long
        cJobs As Long
        AveragePPM As Long
End TypePublic Enum PaperSizeConstants
    cellPaperLetter = 1         '信笺， 8 1/2 x 11 英寸。
    cellPaperLetterSmall = 2    '+A611 小型信笺， 8 1/2 x 11 英寸。
    cellPaperTabloid = 3        '小型报， 11 x 17 英寸。
    cellPaperLedger = 4         '分类帐， 17 x 11 英寸。
    cellPaperLegal = 5          '法律文件， 8 1/2 x 14 英寸。
    cellPaperStatement = 6      '声明书，5 1/2 x 8 1/2 英寸。
    cellPaperExecutive = 7      '行政文件，7 1/2 x 10 1/2 英寸。
    cellPaperA3 = 8             'A3, 297 x 420 毫米
    cellPaperA4 = 9             'A4, 210 x 297 毫米
    cellPaperA4Small = 10       'A4小号， 210 x 297 毫米
    cellPaperA5 = 11            'A5, 148 x 210 毫米
    cellPaperB4 = 12            'B4, 250 x 354 毫米
    cellPaperB5 = 13            'B5, 182 x 257 毫米
    cellPaperFolio = 14         '对开本， 8 1/2 x 13 英寸。
    cellPaperQuarto = 15        '四开本， 215 x 275 毫米。
    cellPaper10x14 = 16         '10 x 14 英寸。
    cellPaper11x17 = 17         '11 x 17 英寸。
    cellPaperNote = 18          '便条，8 1/2 x 11 英寸。
    cellPaperEnv9 = 19          '#9 信封， 3 7/8 x 8 7/8 英寸。
    cellPaperEnv10 = 20         '#10 信封， 4 1/8 x 9 1/2 英寸。
    cellPaperEnv11 = 21         '#11 信封， 4 1/2 x 10 3/8 英寸。
    cellPaperEnv12 = 22         '#12 信封， 4 1/2 x 11 英寸。
    cellPaperEnv14 = 23         '#14 信封， 5 x 11 1/2 英寸。
    cellPaperCSheet = 24        'C 尺寸工作单
    cellPaperDSheet = 25        'D 尺寸工作单
    cellPaperESheet = 26        'E 尺寸工作单
    cellPaperEnvDL = 27         'DL 型信封， 110 x 220 毫米
    cellPaperEnvC3 = 29         'C3 型信封， 324 x 458 毫米
    cellPaperEnvC4 = 30         'C4 型信封， 229 x 324 毫米
    cellPaperEnvC5 = 28         'C5 型信封， 162 x 229 毫米
    cellPaperEnvC6 = 31         'C6 型信封， 114 x 162 毫米
    cellPaperEnvC65 = 32        'C65 型信封，114 x 229 毫米
    cellPaperEnvB4 = 33         'B4 型信封， 250 x 353 毫米
    cellPaperEnvB5 = 34         'B5 型信封，176 x 250 毫米
    cellPaperEnvB6 = 35         'B6 型信封， 176 x 125 毫米
    cellPaperEnvItaly = 36      '信封， 110 x 230 毫米
    cellPaperEnvMonarch = 37    '信封大王， 3 7/8 x 7 1/2 英寸。
    cellPaperEnvPersonal = 38   '信封， 3 5/8 x 6 1/2 英寸。
    cellPaperFanfoldUS = 39     'U.S. 标准复写簿， 14 7/8 x 11 英寸。
    cellPaperFanfoldStdGerman = 40 '德国标准复写簿， 8 1/2 x 12 英寸。
    cellPaperFanfoldLglGerman = 41 '德国法律复写簿， 8 1/2 x 13 英寸。
    cellPaperUser = 256         '用户自定义
End Enum

Private Function GetFormName(ByVal hPrinter As Long, FormSize As SIZEL, strFormName As String) As Integer
    Dim NumForms As Long, I As Long
    Dim FI1 As FORM_INFO_1
    Dim aFI1() As FORM_INFO_1
    Dim Temp() As Byte
    Dim FormIndex As Integer
    Dim BytesNeeded As Long
    Dim RetVal As Long

    strFormName = vbNullString
    FormIndex = 0
    ReDim aFI1(1)

    RetVal = EnumForms(hPrinter, 1, aFI1(0), 0&, BytesNeeded, NumForms)
    ReDim Temp(BytesNeeded)
    ReDim aFI1(BytesNeeded / Len(FI1))

    RetVal = EnumForms(hPrinter, 1, Temp(0), BytesNeeded, BytesNeeded, NumForms)
    Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)

    For I = 0 To NumForms - 1
        With aFI1(I)
            If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then
                strFormName = PtrCtoVbString(.pName)
                FormIndex = I + 1
                Exit For
            End If
        End With
    Next I

    GetFormName = FormIndex
End FunctionPrivate Function AddNewForm(hPrinter As Long, FormSize As SIZEL, strFormName As String) As String
    Dim FI1 As sFORM_INFO_1
    Dim aFI1() As Byte
    Dim RetVal As Long

    With FI1
        .Flags = 0
        .pName = strFormName
        With .Size
            .cx = FormSize.cx
            .cy = FormSize.cy
        End With
        With .ImageableArea
            .Left = 0
            .Top = 0
            .Right = FI1.Size.cx
            .Bottom = FI1.Size.cy
        End With
    End With

    ReDim aFI1(Len(FI1))
    Call CopyMemory(aFI1(0), FI1, Len(FI1))
    RetVal = AddForm(hPrinter, 1, aFI1(0))

    If RetVal = 0 Then
        If Err.LastDllError = 5 Then
            MsgBox "You do not have permissions to add a form to " & _
               Printer.DeviceName, vbExclamation, "Access Denied!"
        Else
            MsgBox "Error: " & Err.LastDllError, , "Error Adding Form"
        End If
        AddNewForm = "none"
    Else
        AddNewForm = FI1.pName
    End If
End FunctionPrivate Function PtrCtoVbString(ByVal Add As Long) As String
    Dim sTemp As String * 512, x As Long

    x = lstrcpy(sTemp, ByVal Add)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
    Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
End FunctionPrivate Sub GetPaperSize(ByVal PaperSize As Long, ByRef PaperWidth As Long, ByRef PaperHeight As Long)
    Select Case PaperSize
    Case 1 '信笺， 8 1/2 x 11 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 11 * 2.54
    Case 2 '+A611 小型信笺， 8 1/2 x 11 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 11 * 2.54
    Case 3 '小型报， 11 x 17 英寸。
        PaperWidth = 11 * 2.54
        PaperHeight = 17 * 2.54
    Case 4 '分类帐， 17 x 11 英寸。
        PaperWidth = 17 * 2.54
        PaperHeight = 11 * 2.54
    Case 5 '法律文件， 8 1/2 x 14 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 14 * 2.54
    Case 6 '声明书，5 1/2 x 8 1/2 英寸。
        PaperWidth = 5.5 * 2.54
        PaperHeight = 8.5 * 2.54
    Case 7 '行政文件，7 1/2 x 10 1/2 英寸。
        PaperWidth = 7.5 * 2.54
        PaperHeight = 10.5 * 2.54
    Case 8 'A3, 297 x 420 毫米
        PaperWidth = 29.7
        PaperHeight = 42
    Case 9 'A4, 210 x 297 毫米
        PaperWidth = 21
        PaperHeight = 29.7
    Case 10 'A4小号， 210 x 297 毫米
        PaperWidth = 21
        PaperHeight = 29.7
    Case 11 'A5, 148 x 210 毫米
        PaperWidth = 14.8
        PaperHeight = 21
    Case 12 'B4, 250 x 354 毫米
        PaperWidth = 25
        PaperHeight = 35.4
    Case 13 'B5, 182 x 257 毫米
        PaperWidth = 18.2
        PaperHeight = 25.7
    Case 14 '对开本， 8 1/2 x 13 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 13 * 2.54
    Case 15 '四开本， 215 x 275 毫米。
        PaperWidth = 21.5
        PaperHeight = 27.5
    Case 16 '10 x 14 英寸。
        PaperWidth = 10 * 2.54
        PaperHeight = 14 * 2.54
    Case 17 '11 x 17 英寸。
        PaperWidth = 11 * 2.54
        PaperHeight = 17 * 2.54
    Case 18 '便条，8 1/2 x 11 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 11 * 2.54
    Case 19 '#9 信封， 3 7/8 x 8 7/8 英寸。
        PaperWidth = 3.875 * 2.54
        PaperHeight = 8.875 * 2.54
    Case 20 '#10 信封， 4 1/8 x 9 1/2 英寸。
        PaperWidth = 4.125 * 2.54
        PaperHeight = 9.5 * 2.54
    Case 21 '#11 信封， 4 1/2 x 10 3/8 英寸。
        PaperWidth = 4.5 * 2.54
        PaperHeight = 10.375 * 2.54
    Case 22 '#12 信封， 4 1/2 x 11 英寸。
        PaperWidth = 4.5 * 2.54
        PaperHeight = 11 * 2.54
    Case 23 '#14 信封， 5 x 11 1/2 英寸。
        PaperWidth = 5 * 2.54
        PaperHeight = 11.5 * 2.54
    Case 24 'C 尺寸工作单
        PaperWidth = 21
        PaperHeight = 29.7
    Case 25 'D 尺寸工作单
        PaperWidth = 21
        PaperHeight = 29.7
    Case 26 'E 尺寸工作单
        PaperWidth = 21
        PaperHeight = 29.7
    Case 27 'DL 型信封， 110 x 220 毫米
        PaperWidth = 11
        PaperHeight = 22
    Case 29 'C3 型信封， 324 x 458 毫米
        PaperWidth = 32.4
        PaperHeight = 45.8
    Case 30 'C4 型信封， 229 x 324 毫米
        PaperWidth = 22.9
        PaperHeight = 32.4
    Case 28 'C5 型信封， 162 x 229 毫米
        PaperWidth = 16.2
        PaperHeight = 22.9
    Case 31 'C6 型信封， 114 x 162 毫米
        PaperWidth = 11.4
        PaperHeight = 16.2
    Case 32 'C65 型信封，114 x 229 毫米
        PaperWidth = 11.4
        PaperHeight = 22.9
    Case 33 'B4 型信封， 250 x 353 毫米
        PaperWidth = 25
        PaperHeight = 35.3
    Case 34 'B5 型信封，176 x 250 毫米
        PaperWidth = 17.6
        PaperHeight = 25
    Case 35 'B6 型信封， 176 x 125 毫米
        PaperWidth = 17.6
        PaperHeight = 12.5
    Case 36 '信封， 110 x 230 毫米
        PaperWidth = 11
        PaperHeight = 23
    Case 37 '信封大王， 3 7/8 x 7 1/2 英寸。
        PaperWidth = 3.875 * 2.54
        PaperHeight = 7.5 * 2.54
    Case 38 '信封， 3 5/8 x 6 1/2 英寸。
        PaperWidth = 3.625 * 2.54
        PaperHeight = 6.5 * 2.54
    Case 39 'U.S. 标准复写簿， 14 7/8 x 11 英寸。
        PaperWidth = 14.875 * 2.54
        PaperHeight = 11 * 2.54
    Case 40 '德国标准复写簿， 8 1/2 x 12 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 12 * 2.54
    Case 41 '德国法律复写簿， 8 1/2 x 13 英寸。
        PaperWidth = 8.5 * 2.54
        PaperHeight = 13 * 2.54
    Case 256 '用户自定义
        Exit Sub
    Case Else
        PaperWidth = 21
        PaperHeight = 29.7
    End Select
End Sub

Public Function SetPaperSize(ByVal MyhWnd As Long, ByVal PaperSize As PaperSizeConstants, Optional ByVal PaperWidth As Long, Optional ByVal PaperHeight As Long) As Boolean
    Dim lngResult As Long, hPrtDC As Long, hPrinter As Long
    Dim pDevMode As DEVMODE
    Dim FormSize As SIZEL
    Dim strPrinterName As String, strFormName As String
    Dim arrDevMode() As Byte
    Dim w As Long, h As Long

    Const FLEXCELL_FORM = "FlexCell Custom Paper"

    strPrinterName = Printer.DeviceName
    hPrtDC = Printer.hdc

    If PaperSize = 256 Then
        With FormSize
            .cx = PaperWidth * 10000
            .cy = PaperHeight * 10000
        End With
    Else
        Call GetPaperSize(PaperSize, w, h)
        With FormSize
            .cx = w * 10000
            .cy = h * 10000
        End With
    End If

    If OpenPrinter(strPrinterName, hPrinter, 0&) Then
        lngResult = DocumentProperties(MyhWnd, hPrinter, strPrinterName, 0&, 0&, 0&)
        ReDim arrDevMode(1 To lngResult)
        lngResult = DocumentProperties(MyhWnd, hPrinter, strPrinterName, arrDevMode(1), 0&, DM_OUT_BUFFER)
        Call CopyMemory(pDevMode, arrDevMode(1), Len(pDevMode))

        '------ 直接设置PaperSize(Start) ------
        If PaperSize <> 256 Then
            '设置纸张大小
            With pDevMode
                .dmPaperSize = PaperSize
                .dmFields = DM_PAPERSIZE
            End With
        Else
            '设置纸张大小为“自定义”，并设置纸张的长度和宽度
            With pDevMode
                .dmPaperSize = PaperSize
                .dmPaperWidth = FormSize.cx / 100
                .dmPaperLength = FormSize.cy / 100
                .dmFields = DM_PAPERSIZE Or DM_PAPERWIDTH Or DM_PAPERLENGTH
            End With
        End If

        '设置到打印机
        Call CopyMemory(arrDevMode(1), pDevMode, Len(pDevMode))
        lngResult = DocumentProperties(MyhWnd, hPrinter, strPrinterName, arrDevMode(1), arrDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)

        '检查设置是否已生效，如果设置成功则退出Function
        Call CopyMemory(pDevMode, arrDevMode(1), Len(pDevMode))
        If pDevMode.dmPaperSize = PaperSize Then
            lngResult = ResetDC(hPrtDC, arrDevMode(1))
            ClosePrinter (hPrinter)
            SetPaperSize = True
            Exit Function
        End If
        '------ 直接设置PaperSize( End ) ------

        '------ 设置PaperSize未生效，需添加自定义纸张(Start) ------
        lngResult = DocumentProperties(MyhWnd, hPrinter, strPrinterName, arrDevMode(1), 0&, DM_OUT_BUFFER)
        Call CopyMemory(pDevMode, arrDevMode(1), Len(pDevMode))

        If GetFormName(hPrinter, FormSize, strFormName) = 0 Then
            Call DeleteForm(hPrinter, FLEXCELL_FORM & Chr(0))
            Call AddNewForm(hPrinter, FormSize, FLEXCELL_FORM)
        End If

        If GetFormName(hPrinter, FormSize, strFormName) = 0 Then
            ClosePrinter (hPrinter)
            Exit Function
        End If

        pDevMode.dmFormName = strFormName & Chr(0)
        pDevMode.dmFields = DM_FORMNAME        Call CopyMemory(arrDevMode(1), pDevMode, Len(pDevMode))
        lngResult = DocumentProperties(MyhWnd, hPrinter, strPrinterName, arrDevMode(1), arrDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
        lngResult = ResetDC(hPrtDC, arrDevMode(1))
        ClosePrinter (hPrinter)

        '检查设置是否已生效
        If CInt(Printer.Width / 567) = CInt(FormSize.cx / 10000) And CInt(Printer.Height / 567) = CInt(FormSize.cy / 10000) Then
            SetPaperSize = True
        End If
        '------ 设置PaperSize未生效，需添加自定义纸张( End ) ------
    End If
End Function

这是我写的一篇《Win2000下打印设定》
有详细源码，联结：http://blog.csdn.net/yefanqiu/archive/2004/07/13/40382.aspx这是部分核心代码：
'*************************************************************************
'**函数名：AddNewForm
'**输    入：PrinterHandle(Long) - 打印机句柄
'**        ：FormSize(SIZEL)     - 格式大小
'**        ：FormName(String)    - 格式名称
'**输    出：(long) - 0 添加成功 1 不允许添加 2 添加失败
'**功能描述：添加新的打印格式
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004年04月02日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, FormName As String) As Long
    Dim FI1 As sFORM_INFO_1
    Dim aFI1() As Byte
    Dim RetVal As Long

    With FI1
        .Flags = 0
        .pName = FormName
        With .Size
            .cx = FormSize.cx
            .cy = FormSize.cy
        End With
        With .ImageableArea
            .Left = 0
            .Top = 0
            .Right = FI1.Size.cx
            .Bottom = FI1.Size.cy
        End With
    End With
    ReDim aFI1(Len(FI1))
    Call CopyMemory(aFI1(0), FI1, Len(FI1))
    RetVal = AddForm(PrinterHandle, 1, aFI1(0))

    If RetVal = 0 Then  '设置失败
        If Err.LastDllError = 5 Then
            '不允许设置打印格式
            AddNewForm = 1
        Else
            'Err.LastDllError
            AddNewForm = 2
        End If
    Else
        AddNewForm = 0
    End If
End Function'*************************************************************************
'**函数名：PtrCtoVbString
'**输    入：ByVal Add(Long) - 字符地址
'**输    出：(String) - 字符串
'**功能描述：返回指定地址的字符串
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004年04月02日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Function PtrCtoVbString(ByVal Add As Long) As String
    Dim sTemp As String * 512, x As Long

    x = lstrcpy(sTemp, ByVal Add)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
    Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
End Function'*************************************************************************
'**函数名：SetPrintForm
'**输    入：ByVal MyhWnd(Long) - 窗体句柄
'**        ：FormName(String)   - 格式的名称
'**        ：lngPageX(Long)     - 宽度值（mm）
'**        ：lngPageY(Long)     - 高度值（mm）
'**输    出：(Integer) - 0 格式无法添加 1 格式已添加 2 格式添加成功
'**功能描述：自定义打印格式
'**全局变量：
'**调用模块：
'**作    者：叶帆
'**日    期：2004年04月02日
'**修改人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Public Function SetPrintForm(ByVal MyhWnd As Long, FormName As String, lngPageX As Long, lngPageY As Long) As Integer
    Dim nSize As Long
    Dim pDevMode As DEVMODE
    Dim PrinterHandle As Long
    Dim hPrtDC As Long
    Dim PrinterName As String
    Dim aDevMode() As Byte
    Dim FormSize As SIZEL

    PrinterName = Printer.DeviceName
    hPrtDC = Printer.hdc
    SetPrintForm = FORM_NOT_SELECTED    '预设格式无法添加

    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, 0&, 0&)
        ReDim aDevMode(1 To nSize)
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, aDevMode(1), 0&, DM_OUT_BUFFER)
        Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))

        '设置大小
        With FormSize
            .cx = lngPageX * 1000  '纸张宽度
            .cy = lngPageY * 1000  '纸张高度
        End With

        '该格式是否定义
        If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then  '不存在这个格式
            '添加该格式
            AddNewForm PrinterHandle, FormSize, FormName
            If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
                ClosePrinter (PrinterHandle)
                SetPrintForm = FORM_NOT_SELECTED   '格式无法添加
                Exit Function
            Else
                SetPrintForm = FORM_ADDED          '格式添加成功
            End If
        End If

        '设置格式的名称
        pDevMode.dmFormName = FormName & Chr(0)
        pDevMode.dmFields = DM_FORMNAME

        '设置改变
        Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)
        nSize = ResetDC(hPrtDC, aDevMode(1))

        ClosePrinter (PrinterHandle)
        If SetPrintForm <> FORM_ADDED Then
           SetPrintForm = FORM_SELECTED            '格式已添加
        End If
    Else
        SetPrintForm = FORM_NOT_SELECTED           '格式无法添加
    End If
End Function

对射天狼兄的取纸张的方法作一个补充，共同交流交流。有关获取纸张大的代码看看这个：http://dev.csdn.net/develop/article/74/74018.shtm

我是win2003 server,用了上面的代码,压根就没效果.

窗体代码：
Option ExplicitPrivate Sub Command1_Click()
    Dim FormName As String
    FormName = "MyCustomForm"   ' Use special, user-defined form.
    UseForm FormName
End SubPrivate Sub Command2_Click()
    Dim FormName As String

    ' Get FormName from the ListBox.
    On Error GoTo ListBoxERR    ' Trap for no selection.
    FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)
    On Error GoTo 0             ' Turn off Error trap.

    UseForm FormName

    Exit Sub
ListBoxERR:
    MsgBox "Select a printer from the ListBox before using this option.", _
       vbExclamation
End SubPrivate Sub Command3_Click()
    Dim RetVal As Long
    Dim PrinterHandle As Long   ' Handle to printer
    Dim PrinterName As String
    Dim FormName As String
    Dim Continue As Long

    ' Delete form that is selected in ListBox.
    PrinterName = Printer.DeviceName  ' Current printer
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then

        On Error GoTo ListBoxERR    ' Trap for no selection.
        FormName = Mid(List1.Text, 1, InStr(1, List1.Text, " -") - 1)
        On Error GoTo 0             ' Turn off Error trap.

        Continue = MsgBox("Are you sure you want to permanently remove " & _
                   FormName & " from " & PrinterName & "?", vbYesNo)
        If Continue = vbYes Then
            RetVal = DeleteForm(PrinterHandle, FormName & Chr(0))
            If RetVal <> 0 Then ' DeleteForm succeeded.
                List1.Clear     ' Reflect the deletion in the ListBox.
                Form_Load       ' Rebuild the list.
                MsgBox FormName & " deleted!", vbInformation, "Success!"
            Else
                MsgBox FormName & " not deleted!" & vbCrLf & vbCrLf & _
                   "Error code: " & Err.LastDllError, vbInformation, "Failure!"
            End If
        End If
        ClosePrinter (PrinterHandle)
    End If

    Exit Sub
ListBoxERR:
    MsgBox "Select a printer from the ListBox before using this option.", _
       vbExclamation
    ClosePrinter (PrinterHandle)
End SubPrivate Sub Form_Load()
    Dim NumForms As Long, I As Long
    Dim FI1 As FORM_INFO_1
    Dim aFI1() As FORM_INFO_1           ' Working FI1 array
    Dim Temp() As Byte                  ' Temp FI1 array
    Dim BytesNeeded As Long
    Dim PrinterName As String           ' Current printer
    Dim PrinterHandle As Long           ' Handle to printer
    Dim FormItem As String              ' For ListBox
    Dim RetVal As Long
    Dim FormSize As SIZEL               ' Size of desired form

    PrinterName = Printer.DeviceName    ' Current printer
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        With FormSize   ' Desired page size
            .cx = 214000
            .cy = 216000
        End With
        ReDim aFI1(1)
        RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, _
                 NumForms)
        ReDim Temp(BytesNeeded)
        ReDim aFI1(BytesNeeded / Len(FI1))
        RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, _
                 BytesNeeded, NumForms)
        Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
        For I = 0 To NumForms - 1
            With aFI1(I)
                ' List name and size including the count (index).
                FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
                   " mm X " & .Size.cy / 1000 & " mm   (" & I + 1 & ")"
                List1.AddItem FormItem
            End With
        Next I
        ClosePrinter (PrinterHandle)
    End If
End SubPrivate Sub UseForm(FormName As String)
    Dim RetVal As Integer
    RetVal = SelectForm(FormName, Me.hwnd)
    Select Case RetVal
        Case FORM_NOT_SELECTED   ' 0
            ' Selection failed!
            MsgBox "Unable to retrieve From name", vbExclamation, _
               "Operation halted!"
        Case FORM_SELECTED   ' 1
            ' Selection succeeded!
            PrintTest     ' Comment this line to avoid printing
        Case FORM_ADDED   ' 2
            ' Form added and selected.
            List1.Clear   ' Reflect the addition in the ListBox
            Form_Load     ' by rebuilding the list.
    End Select
End Sub

模块代码：module1
Option ExplicitPublic Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" _
    (ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, _
    ByVal cbBuf As Long, ByRef pcbNeeded As Long, _
    ByRef pcReturned As Long) As LongPublic Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" _
    (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As LongPublic Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" _
    (ByVal hPrinter As Long, ByVal pFormName As String) As LongPublic Declare Function OpenPrinter Lib "winspool.drv" _
    Alias "OpenPrinterA" (ByVal pPrinterName As String, _
    phPrinter As Long, ByVal pDefault As Long) As LongPublic Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As LongPublic Declare Function DocumentProperties Lib "winspool.drv" _
    Alias "DocumentPropertiesA" (ByVal hwnd As Long, _
    ByVal hPrinter As Long, ByVal pDeviceName As String, _
    pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) _
    As LongPublic Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" _
    (ByVal hdc As Long, lpInitData As Any) As LongPublic Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
    (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Public Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" _
    (ByVal lpString1 As String, ByRef lpString2 As Long) As Long' Optional functions not used in this sample, but may be useful.
Public Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" _
    (ByVal hPrinter As Long, ByVal pFormName As String, _
    ByVal Level As Long, pForm As Byte, ByVal cbBuf As Long, _
    pcbNeeded As Long) As LongPublic Declare Function SetForm Lib "winspool.drv" Alias "SetFormA" _
    (ByVal hPrinter As Long, ByVal pFormName As String, _
    ByVal Level As Long, pForm As Byte) As Long' Constants for DEVMODE
Public Const CCHFORMNAME = 32
Public Const CCHDEVICENAME = 32
Public Const DM_FORMNAME As Long = &H10000
Public Const DM_ORIENTATION = &H1&' Constants for PRINTER_DEFAULTS.DesiredAccess
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
  PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)' Constants for DocumentProperties() call
Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY' Custom constants for this sample's SelectForm function
Public Const FORM_NOT_SELECTED = 0
Public Const FORM_SELECTED = 1
Public Const FORM_ADDED = 2Public Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePublic Type SIZEL
        cx As Long
        cy As Long
End TypePublic Type SECURITY_DESCRIPTOR
        Revision As Byte
        Sbz1 As Byte
        Control As Long
        Owner As Long
        Group As Long
        Sacl As Long  ' ACL
        Dacl As Long  ' ACL
End Type' The two definitions for FORM_INFO_1 make the coding easier.
Public Type FORM_INFO_1
        Flags As Long
        pName As Long   ' String
        Size As SIZEL
        ImageableArea As RECTL
End TypePublic Type sFORM_INFO_1
        Flags As Long
        pName As String
        Size As SIZEL
        ImageableArea As RECTL
End TypePublic Type DEVMODE
        dmDeviceName As String * CCHDEVICENAME
        dmSpecVersion As Integer
        dmDriverVersion As Integer
        dmSize As Integer
        dmDriverExtra As Integer
        dmFields As Long
        dmOrientation As Integer
        dmPaperSize As Integer
        dmPaperLength As Integer
        dmPaperWidth As Integer
        dmScale As Integer
        dmCopies As Integer
        dmDefaultSource As Integer
        dmPrintQuality As Integer
        dmColor As Integer
        dmDuplex As Integer
        dmYResolution As Integer
        dmTTOption As Integer
        dmCollate As Integer
        dmFormName As String * CCHFORMNAME
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End TypePublic Type PRINTER_DEFAULTS
        pDatatype As String
        pDevMode As Long    ' DEVMODE
        DesiredAccess As Long
End TypePublic Type PRINTER_INFO_2
        pServerName As String
        pPrinterName As String
        pShareName As String
        pPortName As String
        pDriverName As String
        pComment As String
        pLocation As String
        pDevMode As DEVMODE
        pSepFile As String
        pPrintProcessor As String
        pDatatype As String
        pParameters As String
        pSecurityDescriptor As SECURITY_DESCRIPTOR
        Attributes As Long
        Priority As Long
        DefaultPriority As Long
        StartTime As Long
        UntilTime As Long
        Status As Long
        cJobs As Long
        AveragePPM As Long
End Type

模块代码:module1
Public Function GetFormName(ByVal PrinterHandle As Long, _
                          FormSize As SIZEL, FormName As String) As Integer
    Dim NumForms As Long, I As Long
    Dim FI1 As FORM_INFO_1
    Dim aFI1() As FORM_INFO_1           ' Working FI1 array
    Dim Temp() As Byte                  ' Temp FI1 array
    Dim FormIndex As Integer
    Dim BytesNeeded As Long
    Dim RetVal As Long

    FormName = vbNullString
    FormIndex = 0
    ReDim aFI1(1)
    ' First call retrieves the BytesNeeded.
    RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, NumForms)
    ReDim Temp(BytesNeeded)
    ReDim aFI1(BytesNeeded / Len(FI1))
    ' Second call actually enumerates the supported forms.
    RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, BytesNeeded, _
             NumForms)
    Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
    For I = 0 To NumForms - 1
        With aFI1(I)
            If .Size.cx = FormSize.cx And .Size.cy = FormSize.cy Then
               ' Found the desired form
                FormName = PtrCtoVbString(.pName)
                FormIndex = I + 1
                Exit For
            End If
        End With
    Next I
    GetFormName = FormIndex  ' Returns non-zero when form is found.
End FunctionPublic Function AddNewForm(PrinterHandle As Long, FormSize As SIZEL, _
                           FormName As String) As String
    Dim FI1 As sFORM_INFO_1
    Dim aFI1() As Byte
    Dim RetVal As Long

    With FI1
        .Flags = 0
        .pName = FormName
        With .Size
            .cx = FormSize.cx
            .cy = FormSize.cy
        End With
        With .ImageableArea
            .Left = 0
            .Top = 0
            .Right = FI1.Size.cx
            .Bottom = FI1.Size.cy
        End With
    End With
    ReDim aFI1(Len(FI1))
    Call CopyMemory(aFI1(0), FI1, Len(FI1))
    RetVal = AddForm(PrinterHandle, 1, aFI1(0))
    If RetVal = 0 Then
        If Err.LastDllError = 5 Then
            MsgBox "You do not have permissions to add a form to " & _
               Printer.DeviceName, vbExclamation, "Access Denied!"
        Else
            MsgBox "Error: " & Err.LastDllError, "Error Adding Form"
        End If
        AddNewForm = "none"
    Else
        AddNewForm = FI1.pName
    End If
End FunctionPublic Function PtrCtoVbString(ByVal Add As Long) As String
    Dim sTemp As String * 512, x As Long

    x = lstrcpy(sTemp, ByVal Add)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
    Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
End FunctionPublic Function SelectForm(FormName As String, ByVal MyhWnd As Long) _
    As Integer
    Dim nSize As Long           ' Size of DEVMODE
    Dim pDevMode As DEVMODE
    Dim PrinterHandle As Long   ' Handle to printer
    Dim hPrtDC As Long          ' Handle to Printer DC
    Dim PrinterName As String
    Dim aDevMode() As Byte      ' Working DEVMODE
    Dim FormSize As SIZEL

    PrinterName = Printer.DeviceName  ' Current printer
    hPrtDC = Printer.hdc              ' hDC for current Printer
    SelectForm = FORM_NOT_SELECTED    ' Set for failure unless reset in code.

    ' Get a handle to the printer.
    If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
        ' Retrieve the size of the DEVMODE.
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, 0&, _
                0&, 0&)
        ' Reserve memory for the actual size of the DEVMODE.
        ReDim aDevMode(1 To nSize)

        ' Fill the DEVMODE from the printer.
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
                aDevMode(1), 0&, DM_OUT_BUFFER)
        ' Copy the Public (predefined) portion of the DEVMODE.
        Call CopyMemory(pDevMode, aDevMode(1), Len(pDevMode))

        ' If FormName is "MyCustomForm", we must make sure it exists
        ' before using it. Otherwise, it came from our EnumForms list,
        ' and we do not need to check first. Note that we could have
        ' passed in a Flag instead of checking for a literal name.
        If FormName = "MyCustomForm" Then
            ' Use form "MyCustomForm", adding it if necessary.
            ' Set the desired size of the form needed.
            With FormSize   ' Given in thousandths of millimeters
'                .cx = 214000   ' width
'                .cy = 216000   ' height
                .cx = 130000  ' width
                .cy = 96000   ' height
            End With
            If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
                ' Form not found - Either of the next 2 lines will work.
                'FormName = AddNewForm(PrinterHandle, FormSize, "MyCustomForm")
                AddNewForm PrinterHandle, FormSize, "MyCustomForm"
                If GetFormName(PrinterHandle, FormSize, FormName) = 0 Then
                    ClosePrinter (PrinterHandle)
                    SelectForm = FORM_NOT_SELECTED   ' Selection Failed!
                    Exit Function
                Else
                    SelectForm = FORM_ADDED  ' Form Added, Selection succeeded!
                End If
            End If
        End If

        ' Change the appropriate member in the DevMode.
        ' In this case, you want to change the form name.
        pDevMode.dmFormName = FormName & Chr(0)  ' Must be NULL terminated!
        ' Set the dmFields bit flag to indicate what you are changing.
        pDevMode.dmFields = DM_FORMNAME

        ' Copy your changes back, then update DEVMODE.
        Call CopyMemory(aDevMode(1), pDevMode, Len(pDevMode))
        nSize = DocumentProperties(MyhWnd, PrinterHandle, PrinterName, _
                aDevMode(1), aDevMode(1), DM_IN_BUFFER Or DM_OUT_BUFFER)

        nSize = ResetDC(hPrtDC, aDevMode(1))   ' Reset the DEVMODE for the DC.

        ' Close the handle when you are finished with it.
        ClosePrinter (PrinterHandle)
        ' Selection Succeeded! But was Form Added?
        If SelectForm <> FORM_ADDED Then SelectForm = FORM_SELECTED
    Else
        SelectForm = FORM_NOT_SELECTED   ' Selection Failed!
    End If
End FunctionPublic Sub PrintTest()
    ' Print two test pages to confirm the page size.
    Printer.Print "Top of Page 1."
    Printer.NewPage
    ' Spacing between lines should reflect the chosen page height.
    Printer.Print "Top of Page 2. - Check the page Height (Length.)"
    Printer.EndDoc
    MsgBox "Check Printer " & Printer.DeviceName, vbInformation, "Done!"
End Sub

我贴的代码来自微软官方，已经接上EPSON LQ300+测试通过,自定义纸张大小在代码中设定，然后用设定的大小来打印。

用wsReport报表打印控件吧,3行代码就完成了

调试易

设置打印纸张大小

解决方案 »