烦死了！一个调用系统打印机属性设置的问题！

Question

WinXDC为调用此过程的form的hwnd，我的代码有什么问题？快快说说看Public Sub SetPrinterP(ByVal WinXDC As Long)
    Dim bPrinterInfo2() As Byte
  
    Dim lResult As Long
    Dim nSize As Long
 
    Dim dm As DEVMODE
    Dim pd As PRINTER_DEFAULTS
    Dim pi2 As PRINTER_INFO_2
    
    '取得当前计算机的打印机名称
    sPrnName = Printer.DeviceName
    
    '打印机信息结构
    pd.DesiredAccess = PRINTER_ALL_ACCESS    ' 取得当前打印机的句柄
If OpenPrinter(sPrnName, hPrinter, pd) Then
    
    '取得打印机打印缓存区的长度
        Call GetPrinter(hPrinter, 2&, 0&, 0&, nSize)
        
        '创建一个打印信息缓存数据数组
        ReDim bPrinterInfo2(1 To nSize) As Byte
        
        ' 填充打印机缓冲区机构
        lResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), _
            nSize, nSize)
            
        '复制打印机信息的固定项目，转换成 VB 类型变量
        Call CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))        ' Get number of bytes requires for
        ' DEVMODE structure
        nSize = DocumentProperties(WinXDC, hPrinter, sPrnName, _
            0&, 0&, 0)
            
        ' Create a buffer of the required size
        ReDim bDevMode(1 To nSize)        ' If PRINTER_INFO_2 points to a DEVMODE
        ' structure, copy it into our buffer
        If pi2.pDevMode Then
            Call CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))
        Else
            ' Otherwise, call DocumentProperties
            ' to get a DEVMODE structure
            Call DocumentProperties(WinXDC, hPrinter, sPrnName, _
                bDevMode(1), 0&, DM_IN_PROMPT)   'DM_OUT_BUFFER)
        End If        ' Copy fixed portion of structure
        ' into VB Type variable
        Call CopyMemory(dm, bDevMode(1), Len(dm))
        With dm
            ' Set new orientation
            .dmOrientation = eOrientation
            .dmFields = DM_ORIENTATION
'            .dmPaperSize = 256
'            .dmPaperLength = height
'            .dmPaperWidth = weight
        End With
        ' Copy our Type back into buffer
        Call CopyMemory(bDevMode(1), dm, Len(dm))
        ' Set new orientation
        Call DocumentProperties(WinXDC, hPrinter, sPrnName, _
            bDevMode(1), bDevMode(1), DM_IN_PROMPT)    'DM_IN_BUFFER Or _
            DM_OUT_BUFFER)        ' Point PRINTER_INFO_2 at our
        ' modified DEVMODE
        pi2.pDevMode = VarPtr(bDevMode(1))
        ' Set new orientation system-wide
        lResult = SetPrinter(hPrinter, 2, pi2, 0&)
'        MsgBox VarPtr(bDevMode(1)) & "     " & dm.dmPaperWidth
        ' Clean up and exit
        Call ClosePrinter(hPrinter)
End If
End Sub

Answer 1

给你一段代码建立一个模块，一个窗体，窗体中有三个按钮模块代码为：   Option Explicit
   
   Dim TestOkButton As Boolean
   ' Global constants for Win32 API
   Public Const CCHDEVICENAME = 32
   Public Const CCHFORMNAME = 32
   Public Const GMEM_FIXED = &H0
   Public Const GMEM_MOVEABLE = &H2
   Public Const GMEM_ZEROINIT = &H40   ' Add appripriate Constants for what you want to change
   Public Const DM_DUPLEX = &H1000&
   Public Const DM_ORIENTATION = &H1&
   Public Const DM_COPIES = &H100&
   Public Const DMDUP_HORIZONTAL = 3
   Public Const DMDUP_SIMPLEX = 1
   Public Const DMDUP_VERTICAL = 2    ' Constants for PrintDialog
   Public Const PD_ALLPAGES = &H0
   Public Const PD_COLLATE = &H10
   Public Const PD_DISABLEPRINTTOFILE = &H80000
   Public Const PD_ENABLEPRINTHOOK = &H1000
   Public Const PD_ENABLEPRINTTEMPLATE = &H4000
   Public Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
   Public Const PD_ENABLESETUPHOOK = &H2000
   Public Const PD_ENABLESETUPTEMPLATE = &H8000
   Public Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
   Public Const PD_HIDEPRINTTOFILE = &H100000
   Public Const PD_NONETWORKBUTTON = &H200000
   Public Const PD_NOPAGENUMS = &H8
   Public Const PD_NOSELECTION = &H4
   Public Const PD_NOWARNING = &H80
   Public Const PD_PAGENUMS = &H2
   Public Const PD_PRINTSETUP = &H40
   Public Const PD_PRINTTOFILE = &H20
   Public Const PD_RETURNDC = &H100
   Public Const PD_RETURNDEFAULT = &H400
   Public Const PD_RETURNIC = &H200
   Public Const PD_SELECTION = &H1
   Public Const PD_SHOWHELP = &H800
   Public Const PD_USEDEVMODECOPIES = &H40000
   Public Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000   ' Constants for PAGESETUPDLG
   Public Const PSD_DEFAULTMINMARGINS = &H0
   Public Const PSD_DISABLEMARGINS = &H10
   Public Const PSD_DISABLEORIENTATION = &H100
   Public Const PSD_DISABLEPAGEPAINTING = &H80000
   Public Const PSD_DISABLEPAPER = &H200
   Public Const PSD_DISABLEPRINTER = &H20
   Public Const PSD_ENABLEPAGEPAINTHOOK = &H40000
   Public Const PSD_ENABLEPAGESETUPHOOK = &H2000
   Public Const PSD_ENABLEPAGESETUPTEMPLATE = &H8000
   Public Const PSD_ENABLEPAGESETUPTEMPLATEHANDLE = &H20000
   Public Const PSD_INHUNDREDTHSOFMILLIMETERS = &H8
   Public Const PSD_INTHOUSANDTHSOFINCHES = &H4
   Public Const PSD_INWININIINTLMEASURE = &H0
   Public Const PSD_MARGINS = &H2
   Public Const PSD_MINMARGINS = &H1
   Public Const PSD_NOWARNING = &H80
   Public Const PSD_RETURNDEFAULT = &H400
   Public Const PSD_SHOWHELP = &H800   ' Custom Global Constants
   Public Const DLG_PRINT = 0
   Public Const DLG_PRINTSETUP = 1   ' type definitions:
   Public Type RECT
         Left As Long
         Top As Long
         Right As Long
         Bottom As Long
   End Type
   
   Public Type POINTAPI
           x As Long
           y As Long
   End Type   Type PRINTSETUPDLG_TYPE
           lStructSize As Long
           hwndOwner As Long
           hDevMode As Long
           hDevNames As Long
           flags As Long
           ptPaperSize As POINTAPI
           rtMinMargin As RECT
           rtMargin As RECT
           hInstance As Long
           lCustData As Long
           lpfnPageSetupHook As Long ' LPPAGESETUPHOOK
           lpfnPagePaintHook As Long ' LPPAGESETUPHOOK
           lpPageSetupTemplateName As String
           hPageSetupTemplate As Long ' HGLOBAL
   End Type   Type PRINTDLG_TYPE
           lStructSize As Long
           hwndOwner As Long
           hDevMode As Long
           hDevNames As Long
           hdc As Long
           flags As Long
           nFromPage As Integer
           nToPage As Integer
           nMinPage As Integer
           nMaxPage As Integer
           nCopies As Integer
           hInstance As Long
           lCustData As Long
           lpfnPrintHook As Long
           lpfnSetupHook As Long
           lpPrintTemplateName As String
           lpSetupTemplateName As String
           hPrintTemplate As Long
           hSetupTemplate As Long
   End Type   Type DEVNAMES_TYPE
           wDriverOffset As Integer
           wDeviceOffset As Integer
           wOutputOffset As Integer
           wDefault As Integer
           extra As String * 100
   End Type   Type DEVMODE_TYPE
           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 Integer
           dmPelsWidth As Long
           dmPelsHeight As Long
           dmDisplayFlags As Long
           dmDisplayFrequency As Long
   End Type

Answer 2

续：   ' API declarations:
   Public Declare Function PrintDialog Lib "comdlg32.dll" _
     Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long   Public Declare Function PageSetupDialog Lib "comdlg32.dll" _
      Alias "PageSetupDlgA" _
      (pSetupPrintdlg As PRINTSETUPDLG_TYPE) As Long   Public Declare Sub CopyMemory Lib "kernel32" _
      Alias "RtlMoveMemory" _
      (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)   Public Declare Function GlobalLock Lib "kernel32" _
      (ByVal hMem As Long) As Long   Public Declare Function GlobalUnlock Lib "kernel32" _
      (ByVal hMem As Long) As Long   Public Declare Function GlobalAlloc Lib "kernel32" _
      (ByVal wFlags As Long, ByVal dwBytes As Long) As Long   Public Declare Function GlobalFree Lib "kernel32" _
      (ByVal hMem As Long) As Long   ' Custom procedures:
      Public Sub ShowPrinter(frmOwner As Form, _
          Optional PrintFlags As Long)       Dim PrintDlg As PRINTDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String       ' Use PrintSetupDialog to get the handle to a memory
       ' block with a DevMode and DevName structures       PrintDlg.lStructSize = Len(PrintDlg)
       PrintDlg.hwndOwner = frmOwner.hWnd       PrintDlg.flags = PrintFlags       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmSize = Len(DevMode)
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PrintDlg.hDevMode)
       If lpDevMode > 0 Then
           CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
       End If       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PrintDlg.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If       ' Call the print dialog up and let the user make changes
       If PrintDialog(PrintDlg) Then           ' First get the DevName structure.
           lpDevName = GlobalLock(PrintDlg.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PrintDlg.hDevNames           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PrintDlg.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
           GlobalFree PrintDlg.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next           ' Set printer object properties according to selections made
           ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
           MsgBox "OK"
       End If       ' Display the results in the immediate (debug) window
       With Printer
           If .Orientation = 1 Then
               strSetting = "Portrait.  "
           Else
               strSetting = "Landscape. "
           End If
           Debug.Print "Copies = " & .Copies, "Orientation = " & _
              strSetting & GetDuplex(Printer.Duplex)
       End With
   End Sub

Answer 3

续：   Public Sub ShowPrinterSetup(frmOwner As Form)
       Dim PRINTSETUPDLG As PRINTSETUPDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE
             
       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String
   
       ' Use PrintDialog to get the handle to a memory
       ' block with a DevMode and DevName structures
   
       PRINTSETUPDLG.lStructSize = Len(PRINTSETUPDLG)
       PRINTSETUPDLG.hwndOwner = frmOwner.hWnd
   
       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0
   
       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PRINTSETUPDLG.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PRINTSETUPDLG.hDevMode)
       If lpDevMode > 0 Then
          CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PRINTSETUPDLG.hDevMode)
       End If
   
       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With
   
       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PRINTSETUPDLG.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PRINTSETUPDLG.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If
   
       ' Call the print dialog up and let the user make changes
       If PageSetupDialog(PRINTSETUPDLG) Then
   
           ' First get the DevName structure.
           lpDevName = GlobalLock(PRINTSETUPDLG.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PRINTSETUPDLG.hDevNames
   
           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PRINTSETUPDLG.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PRINTSETUPDLG.hDevMode)
           GlobalFree PRINTSETUPDLG.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next
   
           ' Set printer object properties according to selections made
          ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
           TestOkButton = True
       End If
   
       ' Display the results in the immediate (debug) window
       With Printer
           If .Orientation = 1 Then
               strSetting = "Portrait.  "
           Else
               strSetting = "Landscape. "
           End If
           Debug.Print "Copies = " & .Copies, "Orientation = " & _
              strSetting & GetDuplex(Printer.Duplex)
       End With
   End Sub   Function GetDuplex(lDuplex As Long) As String
        Dim TempStr As String
              
        If lDuplex = DMDUP_SIMPLEX Then
           TempStr = "Duplex is turned off (1)"
        ElseIf lDuplex = DMDUP_VERTICAL Then
           TempStr = "Duplex is set to VERTICAL (2)"
        ElseIf lDuplex = DMDUP_HORIZONTAL Then
           TempStr = "Duplex is set to HORIZONTAL (3)"
        Else
           TempStr = "Duplex is set to undefined value of " & lDuplex
        End If
        GetDuplex = TempStr   ' Return descriptive text
 End Function

Answer 4

还没完呢，CSDN不允许发连续三条，每条还有着字数限制，烦续：
 Public Sub PrinterSetupDlg(frmOwner As Form, _
          Optional PrintFlags As Long)       Dim PrintDlg As PRINTDLG_TYPE
       Dim DevMode As DEVMODE_TYPE
       Dim DevName As DEVNAMES_TYPE       Dim lpDevMode As Long, lpDevName As Long
       Dim bReturn As Integer
       Dim objPrinter As Printer, NewPrinterName As String
       Dim strSetting As String       ' Use PrintSetupDialog to get the handle to a memory
       ' block with a DevMode and DevName structures       PrintDlg.lStructSize = Len(PrintDlg)
       PrintDlg.hwndOwner = frmOwner.hWnd       PrintDlg.flags = PrintFlags       ' Set the current orientation and duplex setting
       DevMode.dmDeviceName = Printer.DeviceName
       DevMode.dmSize = Len(DevMode)
       DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX _
          Or DM_COPIES
       DevMode.dmOrientation = Printer.Orientation
       DevMode.dmCopies = Printer.Copies
       On Error Resume Next
       DevMode.dmDuplex = Printer.Duplex
       On Error GoTo 0       ' Allocate memory for the initialization hDevMode structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
          GMEM_ZEROINIT, Len(DevMode))
       lpDevMode = GlobalLock(PrintDlg.hDevMode)
       If lpDevMode > 0 Then
           CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
       End If       ' Set the current driver, device, and port name strings
       With DevName
           .wDriverOffset = 8
           .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
           .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
           .wDefault = 0
       End With
       With Printer
           DevName.extra = .DriverName & Chr(0) & _
           .DeviceName & Chr(0) & .Port & Chr(0)
       End With       ' Allocate memory for the initial hDevName structure
       ' and copy the settings gathered above into this memory
       PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
           GMEM_ZEROINIT, Len(DevName))
       lpDevName = GlobalLock(PrintDlg.hDevNames)
       If lpDevName > 0 Then
           CopyMemory ByVal lpDevName, DevName, Len(DevName)
           bReturn = GlobalUnlock(lpDevName)
       End If       ' Call the print dialog up and let the user make changes
       If PrintDialog(PrintDlg) Then           ' First get the DevName structure.
           lpDevName = GlobalLock(PrintDlg.hDevNames)
               CopyMemory DevName, ByVal lpDevName, 45
           bReturn = GlobalUnlock(lpDevName)
           GlobalFree PrintDlg.hDevNames           ' Next get the DevMode structure and set the printer
           ' properties appropriately
           lpDevMode = GlobalLock(PrintDlg.hDevMode)
               CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
           bReturn = GlobalUnlock(PrintDlg.hDevMode)
           GlobalFree PrintDlg.hDevMode
           NewPrinterName = UCase$(Left(DevMode.dmDeviceName, _
               InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
           If Printer.DeviceName <> NewPrinterName Then
               For Each objPrinter In Printers
                  If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                       Set Printer = objPrinter
                  End If
               Next
           End If
           On Error Resume Next           ' Set printer object properties according to selections made
           ' by user
           DoEvents
           With Printer
               .Copies = DevMode.dmCopies
               .Duplex = DevMode.dmDuplex
               .Orientation = DevMode.dmOrientation
           End With
           On Error GoTo 0
       End If
 End Sub
窗体代码为：
   Private Sub cmdPrint_Click()
      ShowPrinter Me
   End Sub   Private Sub cmdPrintSetup_Click()
      ShowPrinter Me, PD_PRINTSETUP
    End Sub   Private Sub cmdPrtSetupDlg_Click()
       ShowPrinterSetup Me
   End Sub
你分别设置好三个按钮的名称属性，运行后再一个个点击试试