PrintDlgでプリンタの名前を正しく取得するには？ (ID:140064)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

>>魔界の仮面弁士様
  ご指摘ありがとうございます。
  そのフォームを丸ごとコピーしてみました。
  ほぼ、某所のサンプルの丸写しで、お恥ずかしいです。

当方、店頭接客業務の人間でプログラムは10年前にC言語検定3級を取った程度でパソコン用語は人並みに分かりますが、プログラムの用語なると、まだまだ分からない物が多いです。

状況としては
  上司より、「自社製のプログラムの調子が悪いから直せ」＞ソースを書いた人間は10年前に退社、連絡不能＞「人手が無いので自力で調べて直せ」＞「何でこんな物の修正に１週間も掛かってるんだ」←今ここ

以上、どうか、よろしくお願い致します。

Option Explicit
    Public OSKIND
    Public UsePrinterForm As Form
    Public vDevNames As DEVNAMES

Public Const GMEM_MOVEABLE = &H2
    Public Const GMEM_ZEROINIT = &H40
    Public Const GHND = GMEM_MOVEABLE Or GMEM_ZEROINIT

Public Const CCHDEVICENAME = 32
    Public Const CCHFORMNAME = 32

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

Public Type 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 Type

Public 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
    dmLogPixels As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Public Type DEVNAMES
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
        extData As String * 256
    End Type

Public Declare Function GlobalAlloc Lib _
    "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Public Declare Function GlobalLock Lib _
    "kernel32" (ByVal hMem As Long) As Long

Public Declare Sub CopyMemory Lib _
    "kernel32" Alias "RtlMoveMemory" (Destination As Any, SOURCE As Any, ByVal Length As Long)

Public Declare Function GlobalUnlock Lib _
    "kernel32" (ByVal hMem As Long) As Long
    
Public Declare Function PrintDlg Lib _
    "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long
    
Public Declare Function GlobalFree Lib _
    "kernel32" (ByVal hMem As Long) As Long

Public Function ShowPrinter(frmOwner As Form, Optional PrintFlags As Variant) As Boolean

Dim vDevMode As DEVMODE
Dim hDevMode As Long
Dim lpDevMode As Long
Dim lpDevNames As Long
Dim hDevNames As Long
Dim vPrintDlg As PrintDlg
Dim NewDeviceName
Dim strSetting
Dim objprm As Printer

vDevMode.dmSize = Len(vDevMode)
vDevMode.dmSpecVersion = 0
vDevMode.dmDriverVersion = 0
vDevMode.dmDriverExtra = 0
vDevMode.dmFields = 0

On Error Resume Next

vDevMode.dmDeviceName = Printer.DeviceName
   
If Printer.PaperSize <> vbPRPSUser Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmPaperSize
    vDevMode.dmPaperSize = Printer.PaperSize
    vDevMode.dmPaperWidth = 0
    vDevMode.dmPaperLength = 0
Else
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmPaperSize Or _
        vDevMode.dmPaperLength Or vDevMode.dmPaperWidth
    vDevMode.dmPaperSize = vbPRPSUser
    vDevMode.dmPaperWidth = Printer.ScaleX(Printer.Width, Printer.ScaleMode, vbHimetric)
    vDevMode.dmPaperLength = Printer.ScaleY(Printer.Height, Printer.ScaleMode, vbHimetric)
End If

vDevMode.dmDefaultSource = Printer.PaperBin

If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmDefaultSource
Else
    Err.Clear
End If

vDevMode.dmPrintQuality = Printer.PrintQuality
   
If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmPrintQuality
Else
    Err.Clear
End If

vDevMode.dmColor = Printer.ColorMode

If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmColor
Else
    Err.Clear
End If

vDevMode.dmDuplex = Printer.Duplex
   
If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmDuplex
Else
    Err.Clear
End If

vDevMode.dmOrientation = Printer.Orientation

If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmOrientation
Else
    Err.Clear
End If

vDevMode.dmScale = Printer.Zoom
   
If Err.Number = 0 Then
    vDevMode.dmFields = vDevMode.dmFields Or vDevMode.dmScale
Else
    Err.Clear
End If

On Error GoTo 0
      
vDevNames.wDriverOffset = 8
vDevNames.wDefault = 0
vDevNames.wDeviceOffset = vDevNames.wDriverOffset + 1 + Len(Printer.DriverName)
vDevNames.wOutputOffset = vDevNames.wDeviceOffset + 1 + Len(Printer.DeviceName)
vDevNames.extData = Printer.DriverName & Chr(0) & Printer.DeviceName & Chr(0) & Printer.Port & Chr(0)

hDevMode = GlobalAlloc(GHND, Len(vDevMode))
lpDevMode = GlobalLock(hDevMode)
CopyMemory ByVal lpDevMode, vDevMode, Len(vDevMode)
GlobalUnlock hDevMode

hDevNames = GlobalAlloc(GHND, Len(vDevNames))
lpDevNames = GlobalLock(hDevNames)
CopyMemory ByVal lpDevNames, vDevNames, Len(vDevNames)
GlobalUnlock hDevNames
   
vPrintDlg.lStructSize = Len(vPrintDlg)
vPrintDlg.hwndOwner = frmOwner.hWnd
vPrintDlg.hDevMode = hDevMode
vPrintDlg.hDevNames = hDevNames
vPrintDlg.Flags = PD_PRINTSETUP

If PrintDlg(vPrintDlg) <> 0 Then

lpDevMode = GlobalLock(vPrintDlg.hDevMode)
    CopyMemory vDevMode, ByVal lpDevMode, Len(vDevMode)
    GlobalUnlock lpDevMode

lpDevNames = GlobalLock(vPrintDlg.hDevNames)
    CopyMemory vDevNames, ByVal lpDevNames, Len(vDevNames)
    GlobalUnlock lpDevNames

GlobalFree vPrintDlg.hDevMode
    GlobalFree vPrintDlg.hDevNames

NewDeviceName = Mid(vDevNames.extData, vDevNames.wDeviceOffset - 8 + 1)
    NewDeviceName = Left(NewDeviceName, InStr(NewDeviceName, Chr(0)) - 1)
         
    If Printer.DeviceName <> NewDeviceName Then
        For Each objprm In Printers
            If UCase(objprm.DeviceName) = UCase(NewDeviceName) Then
                Set Printer = objprm
            End If
        Next
    End If
           
    On Error Resume Next

With Printer
        .Copies = vDevMode.dmCopies
        .Duplex = vDevMode.dmDuplex
        .Orientation = vDevMode.dmOrientation
    End With

ShowPrinter = True

On Error GoTo 0

On Error Resume Next

If vDevMode.dmPaperSize <> vbPRPSUser Then
        Printer.PaperSize = vDevMode.dmPaperSize
    Else
        Printer.PaperSize = vbPRPSUser
        Printer.Width = Printer.ScaleX(vDevMode.dmPaperWidth, vbHimetric, Printer.ScaleMode)
        Printer.Height = Printer.ScaleY(vDevMode.dmPaperLength, vbHimetric, Printer.ScaleMode)
   End If

If Err.Number <> 0 Then
        MsgBox "指定された用紙サイズが不正です", vbOKOnly, "プリンタの設定"
        Err.Clear
    End If

Printer.PaperBin = vDevMode.dmDefaultSource
    Printer.PrintQuality = vDevMode.dmPrintQuality
    Printer.ColorMode = vDevMode.dmColor
    Printer.Duplex = vDevMode.dmDuplex
    Printer.Orientation = vDevMode.dmOrientation
    Printer.Zoom = vDevMode.dmScale
    On Error GoTo 0
Else
    ShowPrinter = False
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
End With

End Function

←解決時は質問者本人がここをチェックしてください。

戻る