プリンター情報の取得設定　味はソコソコ？Excel Tips（しお味）

プリンタ情報の取得/設定

実用的な面ではプリンター関係の処理、設定は業務を日々処理する事を前提とするとかなり重要な事になってきます。ここでは、様々なプリンター関係の処理のうちで基本的なプリンター名の取得やその各々のデバイスに設定されているポート番号を取得するTIPS的なものを考えます。また、これも基本的な印刷時の様々な情報をプリンタ側に設定する基本的なTIPSを紹介します。

●vbaでプリンターの情報を取得するには名前程度ならばvbaのみで可能ですが、ポート番号等はレジストリの情報の取得が必要となってきます。ここではwindowsAPI(Application Programming Interface)を用いて実現させています。 windowsAPIの導入は定型的なコードがありますのでそれを利用します。

（windowsAPIの様々な種類）

(旧)
https://docs.microsoft.com/ja-jp/previous-versions/msdn10/Hh240557(v=MSDN.10)

https://docs.microsoft.com/ja-jp/windows/win32/apiindex/windows-api-list?redirectedfrom=MSDN

レジストリ情報の例

（上記のレジストリ情報の場所：プリンター名とポート番号）
コンピューター\HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Devices

●vbaでのプリンター名の一覧取得

単純に、今使っているプリンター名とポート番号は

MsgBox Application.ActivePrinter

と言うコードで簡単に取得出来ます。

（表示例）　PX-505F Series(ネットワーク) on Ne00:

(参考)
https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.activeprinter

[プリンター一覧情報（名前、ポート番号）の重要性]
現在のプリンターは上記の様に比較的簡単に、名前とポート番号（Ne**の形式）は取得できますが、印刷の自動化等の処理を行う場合自動的に使用するプリンターを設定変更したりする必要があります。
そのような場合にプリンターの一覧情報の取得が必要になってくるわけです。
とりあえず名前の一覧の取得には以下の方法が主なものとして上げられます。

1）Namespace(4)の利用

Shell.Applicationというクラスのオブジェクトの[Shellオブジェクト].NameSpace(4).Itemsコレクションのプロパティ（name）を取り出す操作で、各プリンター名を取得します。

オブジェクトブラウザで見るNamespace(4)の利用の参考情報

2）ExecQueryメソッドの利用

ExecQueryの書式
Set Services = GetObject("winmgmts:").ExecQuery("Select * from Win32_Service Where Name='サービス名'")

3）Accessモジュールの利用

Application.Printersコレクションの
.DeviceNameプロパティ
.DriverNameプロパティ
.Portプロパティ
で取得出来ます。（excelのvbaとは異なります）

上の3種類の方法の具体的なコードは、下のプリンターの名前の一覧表示に示すので参考にしてください。サンプルファイルもダウンロード出来ます。

その他の様々なプリンター情報の取得方法（参考情報）
■■■PowerShell■■■
https://docs.microsoft.com/ja-jp/powershell/scripting/samples/working-with-printers?view=powershell-7.2

■■■コマンドでよければ■■■
C:\Windows\System32\cmd.exe
「wmic printer get name」で名前の一覧が取得出来ます。

一方、ポート番号（Ne**形式）の取得は、vbaでは出来ないので、windowsAPIを使用します。
その方法具体的については下記にある
プリンターのポート番号の取得のための関数（windowsAPIの利用）を参照してください。

プリンターの名前の一覧表示

設定画面

プリンター名の一覧取得の代表的な3つの方法を以下に示します。

プリンター名の一覧取得その1（Namespace(4)の利用）

  Sub GetPrinternames1()        'プリンター名の一覧取得その1（Namespace(4)の利用）

    Dim lrow As Long          '一覧表示用変数（縦方向の表示行移動用）
    Dim win As Object         '「Shell.Application」オブジェクト収容
    Dim Obj_Item As Variant   '「Namespace(4).Items」オブジェクトの処理のための一時収容変数

    Range("b6:b20").Clear     '表示領域の初期化

    lrow = 6
    Set win = CreateObject("Shell.Application")

    For Each Obj_Item In win.Namespace(4).Items
        Cells(lrow, 2) = Obj_Item.Name
        lrow = lrow + 1
    Next

End Sub

プリンター名の一覧取得その2（ExecQueryメソッドの利用）

  Sub GetPrinternames2()          'プリンター名の一覧取得その2（ExecQueryメソッドの利用）

      Dim lrow As Long            '一覧表示用変数（縦方向の表示行移動用）
      Dim tobj As Object
      Dim tInstPrn As Variant
      Dim tprn As Object

      Range("g6:K20").Clear       '表示領域の初期化

      lrow = 6
      Set tobj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
      Set tInstPrn = tobj.ExecQuery("Select * from Win32_Printer")

      For Each tprn In tInstPrn
          Cells(lrow, 7) = tprn.Name
          Cells(lrow, 8) = tprn.Location
          Cells(lrow, 11) = tprn.Default
          lrow = lrow + 1
      Next

  End Sub

プリンター_プリンター名一覧取得1～2(ダウンロード)

プリンター名の一覧取得その3（Accessモジュールの利用）

  Sub getpnames3()   'プリンタ一覧の取得(Accessモジュールの利用）

    Dim prnAccess As New Access.Application
    Dim prnPrinter As Access.Printer

    irow = 6

    For Each prnPrinter In prnAccess.Printers

      pname = prnPrinter.DeviceName
      pport = prnPrinter.Port

      Cells(irow, 2) = pname
      Cells(irow, 6) = pport

      irow = irow + 1

    Next

    Set prnPrinter = Nothing
    Set prnAccess = Nothing

  End Sub

※このコードの実行にはAccessモジュール（ライブラリーファイル）を導入する必要があります
VBEの画面で、「ツール」->「参照設定」
Microsoft Access *** Object Libraryにチェック[OK]ボタンを押す

プリンター_プリンター名一覧取得3(ダウンロード)

プリンターのポート番号の取得のための関数（windowsAPIの利用）
ここでは、windowsAPIを使って、レジストリにあるプリンターのポート番号を取得する方法を紹介します。 vbaだけではレジストリの情報は取得出来ませんのでまず、そのための関数を設定します。

windowsAPIのための宣言

  'GetRegValue関数に必要な各種ＡＰＩの宣言
  Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

  Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

  Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Any, ByVal cbData As Long) As Long

  Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

  Private Const ERROR_SUCCESS = 0

  Private Const REG_SZ = 1

  Private Const KEY_QUERY_VALUE = &H1

  Private Const KEY_SET_VALUE = &H2

  Public Const HKEY_CLASSES_ROOT = &H80000000

  Public Const HKEY_CURRENT_USER = &H80000001

  Public Const HKEY_LOCAL_MACHINE = &H80000002

  Public Const HKEY_USERS = &H80000003

  Public Const HKEY_CURRENT_CONFIG = &H80000005

GetRegValue関数の設定

  Public Function GetRegValue(lngRootKey As Long, strSubKey As String, strName As String) As String

  '概要 レジストリの値を取得する windows API 32ビット、64ビット互換

  '引数 lngRootKey : レジストリルートキー

  '     strSubKey  : レジストリサブキー

  '     strName    : 名前

  '返値 取得したレジストリの値

      Dim lngRet As Long
      Dim hWnd As Long
      Dim strValue As String

      'ハンドルを開く

      hWnd = Application.hWnd

      lngRet = RegOpenKeyEx(lngRootKey, strSubKey, 0, KEY_QUERY_VALUE, hWnd)

      '受け取り値用のバッファを確保

      strValue = String(255, " ")

      '値を取得

      lngRet = RegQueryValueEx(hWnd, strName, 0, 0, ByVal strValue, LenB(strValue))

      'ハンドルを閉じる

      RegCloseKey hWnd

      '取得した値から後続のNullを取り除く

      'strValue = Left(strValue, InStr(strValue, vbNullChar) - 1)

      '取得した値を返り値に設定

      GetRegValue = strValue

  End Function

以上の、宣言、設定によって「GetRegValue」関数が使えるようになり、これを用いてプリンターのポート番号を取得します。

プリンターのポート番号の取得（windowsAPIの利用）

設定画面

上記の「GetRegValue」関数を用いて、プリンター名の取得と同時にそのポート番号も取得します。

  'プリンター名一覧、プリンタの接続パラメータ取得　「Ne**：」

  Sub Regget()

  Dim tempShell As Object      '処理用仮shell用オブジェクト変数
  Dim tempObj As Object        '処理用仮オブジェクト変数
  Dim intRow As Integer        '開始行

  Dim regport As Variant       'ポート番号収容

  Dim ws1 As Worksheet

  Set ws1 = Worksheets("sheet1") 'ワークシート名簡略

  '情報の表示********************************
  ws1.Cells(6, 2) = ""
  ws1.Cells(6, 2) = "現在使用しているプリンタ名 : " & Application.ActivePrinter
  ws1.Cells(7, 2) = Application.ActivePrinter

  ws1.Range(Cells(11, 2), Cells(22, 8)).ClearContents      '表の初期化

  'オブジェクトの設定と繰り返し処理**********
  Set tempShell = CreateObject("Shell.Application")

  intRow = 1

  For Each tempObj In tempShell.Namespace(4).Items    'tempShell.Namespace(4).Itemsはプリンタ名を取得する汎用句的なもの

      If intRow > 1 Then

         'プリンター名表示
         ws1.Cells(intRow + 10, 2) = tempObj.Name
         'レジストリ情報の取得：ポート名
         regport = GetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", tempObj.Name)
         'コンマ区切りで収容（split変数に収容）
         regport = Split(regport, ",")
         'ポート番号のみ表示
         ws1.Cells(intRow + 10, 7) = regport(1)

      End If

      intRow = intRow + 1

  Next

  Set tempShell = Nothing

  End Sub

プリンター_名前一覧/ポート番号取得(ダウンロード)

プリンターの印刷パラメータの設定

設定画面

実際にプリンターで印刷するときの、印刷パラメータを設定します。印刷パラメータの設定ダイアログは「Application.Dialogs(xlDialogPrint).Show」のコード記述で出来ます。

  Sub rprint()

  Dim TopM As Single       '上マージン
  Dim LeftM As Single      '左マージン
  Dim RightM As Single     '右マージン
  Dim BottomM As Single    '下マージン
  Dim HeaderM As Single    'ヘッダーマージン
  Dim FooterM As Single    'フッターマージン
  Dim prtdrv As String     'プリンタードライバー情報

  Dim efrow As Integer     '有効印刷データ
  Dim ws1 As Worksheet

  Set ws1 = Worksheets("sheet1")

  'ActiveSheet.Protect UserInterfaceOnly:=True    'プログラム処理のロック回避アクセス権設定

  efrow = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row


  If efrow <= 1 Then

       MsgBox "印刷するデータがありません。処理を中止します。"

      Exit Sub

  End If

  Application.ScreenUpdating = False


  Worksheets("sheet2").Select


  '各マージンの取得*************************************************

    TopM = ws1.Cells(11, 11)
    LeftM = ws1.Cells(12, 11)
    RightM = ws1.Cells(13, 11)
    BottomM = ws1.Cells(14, 11)
    HeaderM = ws1.Cells(15, 11)
    FooterM = ws1.Cells(16, 11)

    prtdrv = ws1.Cells(7, 2)

  ActivePrinter = prtdrv


   'ページ設定*******************************************************

     With ActiveSheet.PageSetup

          .TopMargin = Application.CentimetersToPoints(TopM)
          .LeftMargin = Application.CentimetersToPoints(LeftM)
          .RightMargin = Application.CentimetersToPoints(RightM)
          .BottomMargin = Application.CentimetersToPoints(BottomM)
          .HeaderMargin = Application.CentimetersToPoints(HeaderM)
          .FooterMargin = Application.CentimetersToPoints(FooterM)

     End With

  Application.ScreenUpdating = True                                      '画面更新再開

  Application.Dialogs(xlDialogPageSetup).Show                            '用紙、マージン選択

  Application.Dialogs(xlDialogPrint).Show Arg13:=ActivePrinter           'プリンタ、印刷枚数


     ' MsgBox ("印刷出力・操作が完了しました")


  End Sub

プリンター_パラメータ設定(ダウンロード)

プリンター情報取得/設定（まとめ）

プリンター情報取得/設定（まとめ）です。
プリンターの名前とポート番号の一覧取得。プリンター印刷時の様々なパラメータを設定します。

プリンター情報取得/設定（まとめ）ダウンロード