请问哪位有调用标准对话框“页面设置”并进行相关处理的代码

Question

要求调用页面设置后，能够准确更改PaperSize、PrinterDevice、Margin、Orientation我有一段代码，很多内容都可以更改了，但就是无法更改打印机名称以及选择的纸张属性。发给大家看看  Private Function ShowPageSetupDlg(frmOwner As Form) As Long
            
          Dim PSD     As PRINTSETUPDLG_TYPE
          Dim DevMode     As DEVMODE_TYPE
          Dim DevName       As DEVNAMES_TYPE
          Dim bReturn     As Integer
          Dim lpDevMode     As Long
          Dim lpDevNames    As Long
          
            
          PSD.lStructSize = Len(PSD)
          PSD.hwndOwner = Me.hWnd
          PSD.hInstance = App.hInstance
          PSD.flags = PSD_MARGINS Or PSD_INHUNDREDTHSOFMILLIMETERS
          '设置初始的页边距
          PSD.rtMargin.Bottom = (Printer.Height - Printer.ScaleTop - Printer.ScaleHeight) / 567 * 1000
          PSD.rtMargin.Left = Printer.ScaleLeft / 567 * 1000
          PSD.rtMargin.Right = (Printer.Width - Printer.ScaleLeft - Printer.ScaleWidth) / 567 * 1000
          PSD.rtMargin.Top = Printer.ScaleTop / 567 * 1000
          '～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
          '设置初始话对话框的纸张和打印方向
          DevMode.dmFields = DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DUPLEX
          DevMode.dmDeviceName = Printer.DeviceName
          DevMode.dmSize = Len(DevMode)
          DevMode.dmPaperWidth = Printer.Width
          DevMode.dmOrientation = Printer.Orientation
          DevMode.dmPaperSize = Printer.PaperSize
          DevMode.dmCopies = Printer.Copies
          DevMode.dmDuplex = Printer.Duplex
          DevMode.dmSize = LenB(DevMode)
          
          
          On Error GoTo 0
    
          '为初始的hDevMode分配内存
          '把上面的DevMode结构体内容拷贝入已经分配的内存中
          On Error Resume Next
          PSD.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
          
          lpDevMode = GlobalLock(PSD.hDevMode)
          
          If lpDevMode > 0 Then
                  CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
                  bReturn = GlobalUnlock(PSD.hDevMode)
                  'GlobalFree PSD.hDevMode
          End If
          
            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
            PSD.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
                                GMEM_ZEROINIT, Len(DevName))
            lpDevNames = GlobalLock(PrintDlg.hDevNames)
            If lpDevName > 0 Then
                CopyMemory ByVal lpDevNames, DevName, Len(DevName)
                bReturn = GlobalUnlock(lpDevNames)
'注：上述bReturn总是返回0值，不知道是怎么回事，使用GetLastError也返回0
            End If
            
          '显示打印页面设置对话框
          If PageSetupDialog(PSD) Then
          '～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～
                  ShowPageSetupDlg = 0
                  lpDevMode = GlobalLock(PSD.hDevMode)
                  CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
                  bReturn = GlobalUnlock(PSD.hDevMode)
                  GlobalFree PSD.hDevMode
                  On Error Resume Next
                  '根据用户选择的值设置打印机的各项参数
                  Printer.Orientation = DevMode.dmOrientation
                  Printer.PaperSize = DevMode.dmPaperSize
                  Printer.PaperBin = DevMode.dmDefaultSource
                  '存储页面设置的参数
                  Printer.ScaleTop = PSD.rtMargin.Top / 1000 * 567
                  Printer.ScaleLeft = PSD.rtMargin.Left / 1000 * 567
                  Printer.ScaleWidth = Printer.Width - PSD.rtMargin.Right / 1000 * 567 - Printer.ScaleLeft
                  Printer.ScaleHeight = Printer.Height - PSD.rtMargin.Bottom / 1000 * 567 - Printer.ScaleTop
                  On Error GoTo 0
          Else
                  ShowPageSetupDlg = -1
          End If
  End Function

Answer 1

樓主看看這個是不是你要的？
Public Declare Function PRINTDLG Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) As LongType PRINTDLG
     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 TypePrivate Sub Command2_Click()
  Dim p As PRINTDLG
  p.lStructSize = Len(p)
  p.hwndOwner = 0 'Me.hWnd
  p.nFromPage = 1
  p.nToPage = 1
  p.nMinPage = 1
  p.nMaxPage = 10
  p.nCopies = 1
  x = PRINTDLG(p)
  'Printer.Print "c"
End Sub

Answer 2

Private Function ShowPageSetupDlg(frmOwner As Form) As Long    Dim PSD     As PRINTSETUPDLG_TYPE
    Dim DevMode     As DEVMODE_TYPE
    Dim DevName       As DEVNAMES_TYPE
    Dim bReturn     As Integer
    Dim lpDevMode     As Long
    Dim lpDevNames    As Long
    
    
    PSD.lStructSize = Len(PSD)
    PSD.hwndOwner = Me.hWnd
    PSD.hInstance = App.hInstance
    PSD.flags = PSD_MARGINS Or PSD_INHUNDREDTHSOFMILLIMETERS
    '设置初始的页边距
    
    PSD.rtMargin.Bottom = (Printer.Height - Printer.ScaleTop - Printer.ScaleHeight) / 567 * 1000
    PSD.rtMargin.Left = Printer.ScaleLeft / 567 * 1000
    PSD.rtMargin.Right = (Printer.Width - Printer.ScaleLeft - Printer.ScaleWidth) / 567 * 1000
    PSD.rtMargin.Top = Printer.ScaleTop / 567 * 1000
    
    '设置初始话对话框的纸张和打印方向
    DevMode.dmDeviceName = Printer.DeviceName
    DevMode.dmFields = DevMode.dmFields Or DM_ORIENTATION Or DM_PAPERSIZE Or DM_COPIES Or DM_DUPLEX Or DM_DEFAULTSOURCE Or DM_PAPERLENGTH Or DM_PAPERWIDTH
    
    
    DevMode.dmSize = Len(DevMode)
    DevMode.dmOrientation = Printer.Orientation
    
    DevMode.dmPaperSize = Printer.PaperSize
    If DevMode.dmPaperSize <= 0 Or DevMode.dmPaperSize >= 256 Then
        DevMode.dmPaperLength = Printer.Height
        DevMode.dmPaperWidth = Printer.Width
    End If
    
    
    DevMode.dmCopies = Printer.Copies
    DevMode.dmDefaultSource = Printer.PaperBin
    
    On Error GoTo 0
    
    '为初始的hDevMode分配内存
    '把上面的DevMode结构体内容拷贝入已经分配的内存中
    On Error Resume Next
    
    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
    
    
    PSD.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
    lpDevNames = GlobalLock(PSD.hDevNames)
    If lpDevNames > 0 Then
        CopyMemory ByVal lpDevNames, DevName, Len(DevName)
        bReturn = GlobalUnlock(lpDevNames)
    End If
    
    PSD.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
    lpDevMode = GlobalLock(PSD.hDevMode)
    
    If lpDevMode > 0 Then
        CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
        bReturn = GlobalUnlock(lpDevMode)
    End If
    
    
    '显示打印页面设置对话框
    If PageSetupDialog(PSD) Then
        ShowPageSetupDlg = 0
        
        lpDevNames = GlobalLock(PSD.hDevNames)
        CopyMemory DevName, ByVal lpDevNames, Len(DevName)
        bReturn = GlobalUnlock(lpDevNames)
        GlobalFree PSD.hDevNames
        
        
        lpDevMode = GlobalLock(PSD.hDevMode)
        CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
        bReturn = GlobalUnlock(lpDevMode)
        GlobalFree PSD.hDevMode
        
        On Error Resume Next
        '根据用户选择的值设置打印机的各项参数
        
        Dim strNewPrinter As String
        strNewPrinter = UCase(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr(0)) - 1))
        
        
        Dim i As Integer
        For i = 0 To Printers.Count - 1
            If UCase(Printers(i).DeviceName) = strNewPrinter Then
                Set Printer = Printers(i)
            End If
        Next i
        
        
        
        Printer.Orientation = DevMode.dmOrientation
        Printer.PaperSize = DevMode.dmPaperSize
        Printer.PaperBin = DevMode.dmDefaultSource
        '存储页面设置的参数
        Printer.ScaleTop = PSD.rtMargin.Top / 1000 * 567
        Printer.ScaleLeft = PSD.rtMargin.Left / 1000 * 567
        Printer.ScaleWidth = Printer.Width - PSD.rtMargin.Right / 1000 * 567 - Printer.ScaleLeft
        Printer.ScaleHeight = Printer.Height - PSD.rtMargin.Bottom / 1000 * 567 - Printer.ScaleTop
        On Error GoTo 0
        Else
        ShowPageSetupDlg = -1
    End If
End Function