APIでプリンタ、用紙、印刷方向を変更したい。

---

下記コードで、プリンタの設定をしています。
用紙の設定がうまくいきません。
というのは、レーザープリンタでＡ４やＡ３を用紙設定ではうまく
いくのですが、ドットプリンタで、給紙方法をトラクタ指定で、
連続紙を設定すると変わっていません。
なにか、処理不足でしょうか？


    Dim strPrinterDeviceName    As String
    Dim udtPrinterDefaults      As PRINTER_DEFAULTS
    Dim lngPrinterHandle        As Long
    Dim lngPrinterInfo2Level    As Long
    Dim lngPrinterInfo2Needed   As Long
    Dim bytPrinterInfo2Buffer() As Byte
    Dim udtPrinterInfo2         As PRINTER_INFO_2
    Dim udtDevMode              As DEVMODE
    Dim lngWin32apiResultCode   As Long
    ' プリンタ名を指定
    strPrinterDeviceName = _
    Printer.DeviceName
    ' プリンタアクセス権を指定
    With udtPrinterDefaults
        .DesiredAccess = PRINTER_ALL_ACCESS
    End With
    ' プリンタのオブジェクトハンドルを取得
    lngWin32apiResultCode = _
    OpenPrinter(strPrinterDeviceName, _
    lngPrinterHandle, _
    udtPrinterDefaults)
    ' 構造体のレベルを指定
    lngPrinterInfo2Level = 2
    ' バッファに必要なサイズを取得
    lngWin32apiResultCode = _
    GetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    ByVal vbNullString, _
    0, _
    lngPrinterInfo2Needed)
    ' バッファを確保
    ReDim _
    bytPrinterInfo2Buffer _
    (lngPrinterInfo2Needed - 1)
    ' 詳細なプリンタ情報を取得
    lngWin32apiResultCode = _
    GetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    bytPrinterInfo2Buffer(0), _
    lngPrinterInfo2Needed, _
    lngPrinterInfo2Needed)
    ' 取得した詳細なプリンタ情報を構造体へ移動
    MoveMemory _
    udtPrinterInfo2, _
    bytPrinterInfo2Buffer(0), _
    Len(udtPrinterInfo2)
    ' 取得した詳細なプリンタデバイス情報を構造体へ移動
    MoveMemory _
    udtDevMode, _
    ByVal udtPrinterInfo2.pDevMode, _
    Len(udtDevMode)
    ' 詳細なプリンタデバイス情報を設定
    With udtDevMode
    ' 用紙が指定できるときは
    If .dmFields And DM_PAPERSIZE Then
    ' 用紙を指定
    .dmPaperSize = _
    CInt(Combo1.ItemData(Combo1.ListIndex))
    ' 構造体を取得した詳細なプリンタデバイス情報へ移動
    MoveMemory _
    ByVal udtPrinterInfo2.pDevMode, _
    udtDevMode, _
    Len(udtDevMode)
    '詳細なプリンタ情報を書き戻し
    lngWin32apiResultCode = _
    SetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    udtPrinterInfo2, _
    0)
    End If
    End With
    ' プリンタオブジェクトをクローズ
    lngWin32apiResultCode = _
    ClosePrinter(lngPrinterHandle)

End Sub

Private Sub Command3_Click()
    
    Dim strPrinterDeviceName    As String
    Dim udtPrinterDefaults      As PRINTER_DEFAULTS
    Dim lngPrinterHandle        As Long
    Dim lngPrinterInfo2Level    As Long
    Dim lngPrinterInfo2Needed   As Long
    Dim bytPrinterInfo2Buffer() As Byte
    Dim udtPrinterInfo2         As PRINTER_INFO_2
    Dim udtDevMode              As DEVMODE
    Dim lngWin32apiResultCode   As Long
    
    ' プリンタ名を指定
    strPrinterDeviceName = _
        Printer.DeviceName
    ' プリンタアクセス権を指定
    With udtPrinterDefaults
        .DesiredAccess = PRINTER_ALL_ACCESS
    End With
    
    ' プリンタのオブジェクトハンドルを取得
    lngWin32apiResultCode = _
        OpenPrinter(strPrinterDeviceName, _
                    lngPrinterHandle, _
                    udtPrinterDefaults)
    ' 構造体のレベルを指定
    lngPrinterInfo2Level = 2
    ' バッファに必要なサイズを取得
    lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
                   lngPrinterInfo2Level, _
                   ByVal vbNullString, _
                   0, _
                   lngPrinterInfo2Needed)
    ' バッファを確保
    ReDim _
        bytPrinterInfo2Buffer _
            (lngPrinterInfo2Needed - 1)
    ' 詳細なプリンタ情報を取得
    lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
                   lngPrinterInfo2Level, _
                   bytPrinterInfo2Buffer(0), _
                   lngPrinterInfo2Needed, _
                   lngPrinterInfo2Needed)
    ' 取得した詳細なプリンタ情報を構造体へ移動
    MoveMemory _
        udtPrinterInfo2, _
        bytPrinterInfo2Buffer(0), _
        Len(udtPrinterInfo2)
    ' 取得した詳細なプリンタデバイス情報を構造体へ移動
    MoveMemory _
        udtDevMode, _
        ByVal udtPrinterInfo2.pDevMode, _
        Len(udtDevMode)
    ' 詳細なプリンタデバイス情報を設定
    With udtDevMode
        ' 印刷方向が指定できるときは
        If .dmFields And DM_ORIENTATION Then
            ' 印刷方向を指定
            .dmOrientation = _
    CInt(Combo1.ItemData(Combo1.ListIndex))
    ' 構造体を取得した詳細なプリンタデバイス情報へ移動
    MoveMemory _
    ByVal udtPrinterInfo2.pDevMode, _
    udtDevMode, _
    Len(udtDevMode)
    '詳細なプリンタ情報を書き戻し
    lngWin32apiResultCode = _
    SetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    udtPrinterInfo2, _
    0)
    End If
    End With
    ' プリンタオブジェクトをクローズ
    lngWin32apiResultCode = _
    ClosePrinter(lngPrinterHandle)

End Sub

Private Sub Command4_Click()

    End

End Sub

Private Sub Command5_Click()
    
    Dim strPrinterDeviceName  As String
    Dim lngWin32apiResultCode As Long
    
    ' プリンタ名を指定
    strPrinterDeviceName = _
        Combo1.Text
    
    ' 通常使うプリンタを設定
    lngWin32apiResultCode = _
        SetDefaultPrinter(strPrinterDeviceName)
    ' 拡張エラーのときは
    If Err.LastDllError Then
        ' エラー情報を表示
        MsgBox _
            "(" & _
            Err.LastDllError & _
            ")" & _
            "設定できません。", _
            vbCritical
    End If

'*******************************************

'    Dim strPrinterDeviceName    As String
    Dim udtPrinterDefaults      As PRINTER_DEFAULTS
    Dim lngPrinterHandle        As Long
    Dim lngPrinterInfo2Level    As Long
    Dim lngPrinterInfo2Needed   As Long
    Dim bytPrinterInfo2Buffer() As Byte
    Dim udtPrinterInfo2         As PRINTER_INFO_2
    Dim udtDevMode              As DEVMODE
'    Dim lngWin32apiResultCode   As Long
    ' プリンタ名を指定
    strPrinterDeviceName = _
    Printer.DeviceName
    ' プリンタアクセス権を指定
    With udtPrinterDefaults
        .DesiredAccess = PRINTER_ALL_ACCESS
    End With
    ' プリンタのオブジェクトハンドルを取得
    lngWin32apiResultCode = _
    OpenPrinter(strPrinterDeviceName, _
    lngPrinterHandle, _
    udtPrinterDefaults)
    ' 構造体のレベルを指定
    lngPrinterInfo2Level = 2
    ' バッファに必要なサイズを取得
    lngWin32apiResultCode = _
    GetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    ByVal vbNullString, _
    0, _
    lngPrinterInfo2Needed)
    ' バッファを確保
    ReDim _
    bytPrinterInfo2Buffer _
    (lngPrinterInfo2Needed - 1)
    ' 詳細なプリンタ情報を取得
    lngWin32apiResultCode = _
    GetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    bytPrinterInfo2Buffer(0), _
    lngPrinterInfo2Needed, _
    lngPrinterInfo2Needed)
    ' 取得した詳細なプリンタ情報を構造体へ移動
    MoveMemory _
    udtPrinterInfo2, _
    bytPrinterInfo2Buffer(0), _
    Len(udtPrinterInfo2)
    ' 取得した詳細なプリンタデバイス情報を構造体へ移動
    MoveMemory _
    udtDevMode, _
    ByVal udtPrinterInfo2.pDevMode, _
    Len(udtDevMode)
    ' 詳細なプリンタデバイス情報を設定
    With udtDevMode
    ' 用紙が指定できるときは
    If .dmFields And DM_PAPERSIZE Then
    ' 用紙を指定
    .dmPaperSize = _
    CInt(Combo2.ItemData(Combo2.ListIndex))
    
'''    .dmPaperSize = 8     'A3
'''    .dmPaperSize = 9     'A4
'''    .dmPaperSize = 153   '連続紙 12x4inch
'''    .dmPaperSize = 154   '連続紙 12x4 1/2inch
'''    .dmPaperSize = 156   '連続紙 12x5inch
'''    .dmPaperSize = 159   '連続紙 12x6inch

    ' 構造体を取得した詳細なプリンタデバイス情報へ移動
    MoveMemory _
    ByVal udtPrinterInfo2.pDevMode, _
    udtDevMode, _
    Len(udtDevMode)
    '詳細なプリンタ情報を書き戻し
    lngWin32apiResultCode = _
    SetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    udtPrinterInfo2, _
    0)
    End If
    End With
    ' プリンタオブジェクトをクローズ
    lngWin32apiResultCode = _
    ClosePrinter(lngPrinterHandle)

'*************************************

'    Dim strPrinterDeviceName    As String
'    Dim udtPrinterDefaults      As PRINTER_DEFAULTS
'    Dim lngPrinterHandle        As Long
'    Dim lngPrinterInfo2Level    As Long
'    Dim lngPrinterInfo2Needed   As Long
'    Dim bytPrinterInfo2Buffer() As Byte
'    Dim udtPrinterInfo2         As PRINTER_INFO_2
'    Dim udtDevMode              As DEVMODE
'    Dim lngWin32apiResultCode   As Long
    
    ' プリンタ名を指定
    strPrinterDeviceName = _
        Printer.DeviceName
    ' プリンタアクセス権を指定
    With udtPrinterDefaults
        .DesiredAccess = PRINTER_ALL_ACCESS
    End With
    
    ' プリンタのオブジェクトハンドルを取得
    lngWin32apiResultCode = _
        OpenPrinter(strPrinterDeviceName, _
                    lngPrinterHandle, _
                    udtPrinterDefaults)
    ' 構造体のレベルを指定
    lngPrinterInfo2Level = 2
    ' バッファに必要なサイズを取得
    lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
                   lngPrinterInfo2Level, _
                   ByVal vbNullString, _
                   0, _
                   lngPrinterInfo2Needed)
    ' バッファを確保
    ReDim _
        bytPrinterInfo2Buffer _
            (lngPrinterInfo2Needed - 1)
    ' 詳細なプリンタ情報を取得
    lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
                   lngPrinterInfo2Level, _
                   bytPrinterInfo2Buffer(0), _
                   lngPrinterInfo2Needed, _
                   lngPrinterInfo2Needed)
    ' 取得した詳細なプリンタ情報を構造体へ移動
    MoveMemory _
        udtPrinterInfo2, _
        bytPrinterInfo2Buffer(0), _
        Len(udtPrinterInfo2)
    ' 取得した詳細なプリンタデバイス情報を構造体へ移動
    MoveMemory _
        udtDevMode, _
        ByVal udtPrinterInfo2.pDevMode, _
        Len(udtDevMode)
    ' 詳細なプリンタデバイス情報を設定
    With udtDevMode
        ' 印刷方向が指定できるときは
        If .dmFields And DM_ORIENTATION Then
            ' 印刷方向を指定
            .dmOrientation = _
            CInt(Combo3.ItemData(Combo3.ListIndex))
    
'''            .dmOrientation = 0   '縦
'''            .dmOrientation = 1   '横

    ' 構造体を取得した詳細なプリンタデバイス情報へ移動
    MoveMemory _
    ByVal udtPrinterInfo2.pDevMode, _
    udtDevMode, _
    Len(udtDevMode)
    '詳細なプリンタ情報を書き戻し
    lngWin32apiResultCode = _
    SetPrinter(lngPrinterHandle, _
    lngPrinterInfo2Level, _
    udtPrinterInfo2, _
    0)
    End If
    End With
    ' プリンタオブジェクトをクローズ
    lngWin32apiResultCode = _
    ClosePrinter(lngPrinterHandle)

'*************************************

'    Dim strPrinterDeviceName    As String
'    Dim udtPrinterDefaults      As PRINTER_DEFAULTS
'    Dim lngPrinterHandle        As Long
'    Dim lngPrinterInfo2Level    As Long
'    Dim lngPrinterInfo2Needed   As Long
'    Dim bytPrinterInfo2Buffer() As Byte
'    Dim udtPrinterInfo2         As PRINTER_INFO_2
'    Dim udtDevMode              As DEVMODE
'    Dim lngWin32apiResultCode   As Long
    ' プリンタ名を指定
    strPrinterDeviceName = _
        Printer.DeviceName
        ' プリンタアクセス権を指定
        With udtPrinterDefaults
            .DesiredAccess = PRINTER_ALL_ACCESS
        End With
        ' プリンタのオブジェクトハンドルを取得
        lngWin32apiResultCode = _
            OpenPrinter(strPrinterDeviceName, _
            lngPrinterHandle, _
            udtPrinterDefaults)
        ' 構造体のレベルを指定
        lngPrinterInfo2Level = 2
        ' バッファに必要なサイズを取得
        lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
        lngPrinterInfo2Level, _
        ByVal vbNullString, _
        0, _
        lngPrinterInfo2Needed)
        ' バッファを確保
        ReDim _
        bytPrinterInfo2Buffer _
        (lngPrinterInfo2Needed - 1)
        ' 詳細なプリンタ情報を取得
        lngWin32apiResultCode = _
        GetPrinter(lngPrinterHandle, _
        lngPrinterInfo2Level, _
        bytPrinterInfo2Buffer(0), _
        lngPrinterInfo2Needed, _
        lngPrinterInfo2Needed)
        ' 取得した詳細なプリンタ情報を構造体へ移動
        MoveMemory _
        udtPrinterInfo2, _
        bytPrinterInfo2Buffer(0), _
        Len(udtPrinterInfo2)
        ' 取得した詳細なプリンタデバイス情報を構造体へ移動
        MoveMemory _
        udtDevMode, _
        ByVal udtPrinterInfo2.pDevMode, _
        Len(udtDevMode)
        ' 詳細なプリンタデバイス情報を設定
        With udtDevMode
        ' 給紙方法が指定できるときは
        If .dmFields And DM_DEFAULTSOURCE Then
        ' 給紙方法を指定
        .dmDefaultSource = _
        CInt(Combo4.ItemData(Combo4.ListIndex))
        
'''        .dmDefaultSource = 263   '自動
'''        .dmDefaultSource = 289   '手差し
'''        .dmDefaultSource = 290   'リアプッシュトラクタ
        
        ' 構造体を取得した詳細なプリンタデバイス情報へ移動
        MoveMemory _
        ByVal udtPrinterInfo2.pDevMode, _
        udtDevMode, _
        Len(udtDevMode)
        '詳細なプリンタ情報を書き戻し
        lngWin32apiResultCode = _
        SetPrinter(lngPrinterHandle, _
        lngPrinterInfo2Level, _
        udtPrinterInfo2, _
        0)
        End If
        End With
        ' プリンタオブジェクトをクローズ
        lngWin32apiResultCode = _
        ClosePrinter(lngPrinterHandle)

編集 削除

---

嫌がらせに近いな。色んな意味でもう少しどうにかならんのかと。
移動元
http://www7.big.or.jp/~pinball/discus/vb/59186.html

編集 削除

---

>なにか、処理不足でしょうか？
不足しているのは、処理ではなくモラル。

編集 削除

---

API関数の(Advanced)DocumentPropertiesを用いて、正しいとされる
DEVMODEを取得し、そのサイズやフィールドの値を比較してみては。

まぁ、しかし無駄なコードの提示ですね。

編集 削除

---

名前

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

本文

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