概要
プリンタードライバーの印刷設定を一時的に変更し、処理が完了したら元の状態に戻します。
印刷設定はプログラミングでのレジストリ更新等では変更できません。
「undll32.exe printui.dll,PrintUIEntry」コマンドを使って更新を行います。
PrintPages、PrintPagesEx、PrintPagesSilent、PrintPagesSilentEx でデフォルトプリンターを変更する必要が出てきた時に流用するサンプルです。
詳細
以下はプリンタードライバー「Adobe PDF」に対しての例です。
手動操作での事前作業：
- 目的のプリンタードライバー「Adobe PDF」の印刷設定を変更します。
- この変更後の印刷設定の内容を"henko.dat"に保存します。
以下のコマンドをMS DOS画面で実行します。rundll32.exe printui.dll PrintUIEntry /Ss /n "Adobe PDF" /a "henko.dat" - プリンタードライバーの印刷設定を変更前の状態に戻します。
プログラミング：
- プリンタードライバー「Adobe PDF」の現在の印刷設定の内容をファイルに保存します。
以下のコマンドをMS DOS画面で実行します。rundll32.exe printui.dll PrintUIEntry /Ss /n "Adobe PDF" /a "fukugen.dat" - 印刷設定を事前準備したファイルを使って更新します。
以下のコマンドをMS DOS画面で実行します。※「/Sr」に注目。rundll32.exe printui.dll PrintUIEntry /Sr /n "Adobe PDF" /a "henko.dat" - プリンタードライバー「Adobe PDF」の印刷設定は変更されました。目的の処理をプログラミングで実行します。
- プリンタードライバー「Adobe PDF」の印刷設定を元に戻します。
以下のコマンドをMS DOS画面で実行します。rundll32.exe printui.dll PrintUIEntry /Sr /n "Adobe PDF" /a "fukugen.dat"
なお、２以降の処理はエラーが有っても必ず４を実行して終了する様にします。
サンプル
上記詳細のプログラミングに書いた手順でプリンタードライバー「Adobe PDF」の印刷設定を保存、更新、復元します。
Download：sample-UpdatePrinterSetting.xls
001 Option Explicit
002
003 ' プリンター名
004 Private Const CON_PRINTER = "Adobe PDF"
005 ' 手作業で変更した印刷設定のファイル
006 Private Const CON_PRINTER_UPDATE = "D:¥work¥PRINTER_UPDATE.dat"
007 ' 復元用の印刷設定のファイル
008 Private Const CON_PRINTER_BACKUP = "D:¥work¥PRINTER_BACKUP.dat"
009 Private Const CON_FOUND = 99999
010
011 '===============================================================
012 '
013 ' サンプル：プリンタードライバー「Adobe PDF」の印刷設定をファイルへ保存
014 '
015 ' 機能 : プリンターの印刷設定をファイルへ保存します。
016 ' 「undll32.exe printui.dll,PrintUIEntry」
017 ' コマンドで操作を行う。
018 '
019 ' Create : 2017/09/05
020 ' Update :
021 ' Vertion : 1.0.1
022 '
023 ' 備考 : 他の関数も使用している。
024 ' URL : https://pdf-file.nnn2.com/?p=1019
025 ' その他 : 著作権等は主張しません。
026 ' 上記URLにコメントを頂けると嬉しいです。
027 '
028 '===============================================================
029
030 Sub UpdatePrinterSetting_Save()
031 Dim strPrinterName() As String
032 Dim i As Long
033 Dim bRet As Boolean
034
035 'PCに登録されているプリンター名を全て取得する
036 bRet = nnn2GetAllPrinters(strPrinterName)
037
038 For i = 0 To UBound(strPrinterName)
039 If CON_PRINTER = strPrinterName(i) Then
040 '同じプリンター名が見つかった
041 i = CON_FOUND
042 Exit For
043 End If
044 Next i
045 If i <> CON_FOUND Then
046 'エラー：This printer name does not exist.
047 MsgBox "このプリンター名はPCに存在しない。" & vbCrLf & _
048 "処理は中断します。" & vbCrLf & _
049 "(" & CON_PRINTER & ")", vbCritical, _
050 "エラー：UpdatePrinterSetting_Save"
051 Exit Sub
052 End If
053
054 '保存先フォルダの存在の確認
055 If Dir(Left$(CON_PRINTER_UPDATE, InStrRev(CON_PRINTER_UPDATE, "¥")), vbDirectory) = "" Then
056 MsgBox CON_PRINTER_UPDATE & vbCrLf & _
057 "このフォルダが存在しません。" & vbCrLf & _
058 "処理は中断します。", vbCritical, _
059 "エラー：UpdatePrinterSetting_Save"
060 Exit Sub
061 End If
062
063 '事前確認
064 If vbCancel = MsgBox("(" & CON_PRINTER & ")を保存します。" & vbCrLf & _
065 "よろしいですか？", vbQuestion + vbOKCancel, "確認") Then
066 Exit Sub
067 End If
068
069 'コマンドライン実行で使う変数
070 Dim strCmd As String
071 Dim strOutFile(1) As String
072 Dim strErr As String
073 Dim strWorkFolder As String
074 Dim lRetCode As Long
075 Dim lErrCount As Long
076 Dim lErrCode(0) As Long
077
078 '終了コードのセット
079 lErrCode(0) = 0
080 lErrCount = UBound(lErrCode)
081 strCmd = "rundll32.exe printui.dll,PrintUIEntry /Ss /n """ _
082 & CON_PRINTER & """ /a """ & CON_PRINTER_UPDATE & """"
083
084 '▼① 手作業で変更した印刷設定をファイル保存します。
085 'コマンドラインの実行
086 bRet = RunCommandLineEX(strCmd, strWorkFolder, _
087 lErrCount, lErrCode, _
088 strOutFile, strErr, lRetCode)
089
090 If bRet = True Then
091 MsgBox CON_PRINTER_UPDATE & vbCrLf & _
092 "印刷設定の変更は保存されました。", vbInformation, "完了"
093 Else
094 MsgBox CON_PRINTER_UPDATE & vbCrLf & _
095 "印刷設定の保存は失敗しました。" & vbCrLf & vbCrLf & _
096 strErr, vbCritical, "エラー"
097 End If
098
099 End Sub
100
101 '===============================================================
102 '
103 ' サンプル：プリンタードライバー「Adobe PDF」を変更と復元
104 '
105 ' 機能 : プリンターの印刷設定の変更と復元をします。
106 ' 「undll32.exe printui.dll,PrintUIEntry」
107 ' コマンドで操作を行う。
108 '
109 ' Create : 2017/09/05
110 ' Update :
111 ' Vertion : 1.0.1
112 '
113 ' 備考 : 他の関数も使用している。
114 ' URL : https://pdf-file.nnn2.com/?p=1019
115 ' その他 : 著作権等は主張しません。
116 ' 上記URLにコメントを頂けると嬉しいです。
117 '
118 '===============================================================
119
120 Sub UpdatePrinterSetting_Restore()
121
122 If Dir(CON_PRINTER_UPDATE) = "" Then
123 MsgBox "先に印刷設定を変更して" & vbCrLf & _
124 "「1．変更した印刷設定を事前に保存する。」ボタンを" & vbCrLf & _
125 "クリックしてください。" & vbCrLf & vbCrLf & _
126 "処理は中断します。", vbInformation, "警告"
127 Exit Sub
128 End If
129
130 Dim strPrinterName() As String
131 Dim i As Long
132 Dim bRet As Boolean
133
134 'PCに登録されているプリンター名を全て取得する
135 bRet = nnn2GetAllPrinters(strPrinterName)
136
137 For i = 0 To UBound(strPrinterName)
138 If CON_PRINTER = strPrinterName(i) Then
139 '同じプリンター名が見つかった
140 i = CON_FOUND
141 Exit For
142 End If
143 Next i
144 If i <> CON_FOUND Then
145 'エラー：This printer name does not exist.
146 MsgBox "このプリンター名はPCに存在しない。" & vbCrLf & _
147 "処理は中断します。" & vbCrLf & _
148 "(" & CON_PRINTER & ")", vbCritical, _
149 "エラー：UpdatePrinterSetting_Restore"
150 Exit Sub
151 End If
152
153 '保存先フォルダの存在の確認
154 If Dir(Left$(CON_PRINTER_BACKUP, InStrRev(CON_PRINTER_BACKUP, "¥")), vbDirectory) = "" Then
155 MsgBox CON_PRINTER_BACKUP & vbCrLf & _
156 "このフォルダが存在しません。" & vbCrLf & _
157 "処理は中断します。", vbCritical, _
158 "エラー：UpdatePrinterSetting_Restore"
159 Exit Sub
160 End If
161
162 '実行の確認
163 If vbCancel = MsgBox("② (" & CON_PRINTER & ")を保存します。" & vbCrLf & _
164 "よろしいですか？", vbQuestion + vbOKCancel, "確認") Then
165 MsgBox "処理は中断しました。", vbInformation, "お知らせ"
166 Exit Sub
167 End If
168
169 'コマンドライン実行で使う変数
170 Dim strCmd As String
171 Dim strOutFile(1) As String
172 Dim strErr As String
173 Dim strWorkFolder As String
174 Dim lRetCode As Long
175 Dim lErrCount As Long
176 Dim lErrCode(0) As Long
177
178 '終了コードのセット
179 lErrCode(0) = 0
180 lErrCount = UBound(lErrCode)
181 strCmd = "rundll32.exe printui.dll,PrintUIEntry /Ss /n """ _
182 & CON_PRINTER & """ /a """ & CON_PRINTER_BACKUP & """"
183
184 '▼② 印刷設定を変更する前に、現状の印刷設定をファイル保存します。
185
186 'コマンドラインの実行
187 bRet = RunCommandLineEX(strCmd, strWorkFolder, _
188 lErrCount, lErrCode, _
189 strOutFile, strErr, lRetCode)
190
191 If bRet = False Then
192 MsgBox strCmd & vbCrLf & strErr & vbCrLf & _
193 "（保存）コマンドラインの実行は失敗しました。" & vbCrLf & _
194 "処理は中断します。", vbCritical, "エラー"
195 GoTo UpdatePrinterSetting_Restore_Skip:
196 End If
197
198 '▼③ 印刷設定を変更します。
199 strCmd = "rundll32.exe printui.dll,PrintUIEntry /Sr /n """ _
200 & CON_PRINTER & """ /a """ & CON_PRINTER_UPDATE & """"
201
202 'コマンドラインの実行
203 bRet = RunCommandLineEX(strCmd, strWorkFolder, _
204 lErrCount, lErrCode, _
205 strOutFile, strErr, lRetCode)
206
207 If bRet = False Then
208 MsgBox strCmd & vbCrLf & strErr & vbCrLf & _
209 "（更新）コマンドラインの実行は失敗しました。" & vbCrLf & _
210 "処理は中断します。", vbCritical, "エラー"
211 GoTo UpdatePrinterSetting_Restore_Skip:
212 End If
213
214
215 '処理を実行する。
216 MsgBox "③ この後でその他の処理を実行します。", vbInformation, "お知らせ"
217
218
219 '------------------------------------------------------------
220 '
221 '
222 ' ★ここで変更された印刷設定の状態でイロイロな処理を行う。★
223 '
224 '
225 '------------------------------------------------------------
226
227
228 UpdatePrinterSetting_Restore_Skip:
229
230 '▼④ 印刷設定を復元します。
231 strCmd = "rundll32.exe printui.dll,PrintUIEntry /Sr /n """ _
232 & CON_PRINTER & """ /a """ & CON_PRINTER_BACKUP & """"
233
234 'コマンドラインの実行
235 bRet = RunCommandLineEX(strCmd, strWorkFolder, _
236 lErrCount, lErrCode, _
237 strOutFile, strErr, lRetCode)
238
239 If bRet = False Then
240 MsgBox strCmd & vbCrLf & strErr & vbCrLf & _
241 "（更新）コマンドラインの実行は失敗しました。" & vbCrLf & _
242 "処理は中断します。", vbCritical, "エラー"
243 Else
244 MsgBox "④ 正常終了しました。", vbInformation, "お知らせ"
245 End If
246
247 'ファイルを削除する
248 Kill CON_PRINTER_BACKUP
249 ' Kill CON_PRINTER_UPDATE
250
251 End Sub
Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
001 Option Explicit
002
003 Declare Function WaitForSingleObject Lib "kernel32" _
004 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
005 Declare Function CloseHandle Lib "kernel32" _
006 (ByVal hObject As Long) As Long
007 Declare Function GetExitCodeProcess Lib "kernel32" _
008 (ByVal hProcess As Long, lpExitCode As Long) As Long
009 Declare Function OpenProcess Lib "kernel32" _
010 (ByVal dwDesiredAccess As Long, _
011 ByVal bInheritHandle As Long, _
012 ByVal dwProcessID As Long) As Long
013 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
014
015 Const SYNCHRONIZE = 1048576
016 Const PROCESS_QUERY_INFORMATION = &H400
017
018 ' Teme File No
019 Private gFileCnt As Long
020 ' Debug Mode [ True=On | False=Off ]
021 Private gDebugMode As Boolean
022 Private Const CON_FOLDER_KUGIRI = "¥"
023 Private Const CON_READ = False
024
025
026 '**************************************************
027 '
028 ' Run command line & Get messeges
029 '
030 ' 機能 : コマンドラインを実行する。
031 ' 実行プロセスを監視して終了を待つ。
032 ' 終了メッセージ(標準出力,標準エラー出力)を取得する。
033 ' Create : 2016/07/29
034 ' Update : 2016/08/01
035 ' Vertion : 1.0.1
036 '
037 ' 第１引数：strInCommand As String (In)
038 ' コマンドライン
039 ' 第２引数：strInWorkFolder As String (In)
040 ' 一時的な作業フォルダ
041 ' 第３引数：lInErrCount As Long (In)
042 ' 終了コードの数。 -1:無し
043 ' 第４引数：lInErrCode() As Long (In)
044 ' 終了コードの配列
045 ' 第５引数：strOutFile() As String (Out)
046 ' strOutFile(0)：標準出力の内容
047 ' strOutFile(1)：標準エラー出力の内容
048 ' 第６引数：strOutErrMsg As String (Out)
049 ' プログラム内のエラーメッセージ。エラー無しは ""。
050 ' 第７引数：lOutRetCode As Long (Out)
051 ' コマンドラインの終了コード
052 '
053 ' 戻り値 : True:正常終了 False:エラー発生
054 '
055 ' 備考 : 引数5,6,7の内容でエラー判定を行う。
056 ' URL : https://pdf-file.nnn2.com/?p=908
057 ' その他 : 著作権等は主張しません。
058 ' 上記URLにコメントを頂けると嬉しいです。
059 '
060 '**************************************************
061
062 Public Function RunCommandLineEX( _
063 ByVal strInCommand As String, _
064 ByVal strInWorkFolder As String, _
065 ByVal lInErrCount As Long, _
066 ByRef lInErrCode() As Long, _
067 ByRef strOutFile() As String, _
068 ByRef strOutErrMsg As String, _
069 ByRef lOutRetCode As Long) As Boolean
070 On Error GoTo Err_RunCommandLineEX:
071
072 Dim strCmd As String
073 Dim strFilePath As String
074 Dim strTempFilePath(1) As String
075 Dim i As Long
076
077 '初期化
078 RunCommandLineEX = True
079 strOutErrMsg = ""
080 For i = 0 To UBound(strOutFile)
081 strOutFile(i) = ""
082 Next i
083 If Trim$(strInWorkFolder) = "" Then
084 strInWorkFolder = _
085 Application.ActiveWorkbook.Path & CON_FOLDER_KUGIRI
086 End If
087
088 '▼コマンドラインの編集
089 '一時ファイル
090 gFileCnt = gFileCnt + 1
091 strFilePath = strInWorkFolder & _
092 Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt
093 '標準出力用
094 strTempFilePath(0) = strFilePath & ".txt"
095 '標準エラー出力用
096 strTempFilePath(1) = strFilePath & "-err.txt"
097
098 '注意：ファイルパスの前後にダブルクォーテーション
099 strCmd = "cmd /c " & strInCommand & _
100 " > """ & strTempFilePath(0) & _
101 """ 2> """ & strTempFilePath(1) & """"
102
103 '▼コマンドラインの実行
104 Dim hProcess As Long
105 Dim lpdwExitCode As Long
106 Dim dwProcessID As Long
107 Dim lRet As Long
108 Dim lCnt As Long
109 Const CON_SLEEP = 20
110 Const CON_LOOP_CNT = 250
111 lCnt = 0
112 dwProcessID = Shell(strCmd, vbHide)
113 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _
114 True, dwProcessID)
115 Do
116 Sleep CON_SLEEP
117 DoEvents
118 lRet = GetExitCodeProcess(hProcess, lpdwExitCode)
119 If lInErrCount >= 0 Then
120 For i = 0 To UBound(lInErrCode)
121 If lInErrCode(i) = lpdwExitCode Then Exit Do
122 Next i
123 End If
124 lCnt = lCnt + 1
125 If lCnt > CON_LOOP_CNT Then
126 strOutErrMsg = "[RunCommandLine]Shell Error : " & _
127 "Time Orver " & CON_SLEEP * CON_LOOP_CNT & "ms"
128 RunCommandLineEX = False
129 Exit Do
130 End If
131 If gDebugMode Then _
132 Debug.Print "lCnt=" & lCnt & " " & lpdwExitCode
133 Loop While lpdwExitCode <> 0
134 lOutRetCode = lpdwExitCode
135 If gDebugMode Then _
136 Debug.Print "lCnt=" & lCnt & " " & lpdwExitCode
137
138 If CON_READ Then
139
140 '▼コマンドラインの標準出力と標準エラー出力を取得
141 '▽① 出力テキストを読み込む。
142 ' UTF-8なのでADODB.Streamを使って変換して読み込む。
143 Dim strBuff As String
144 Dim objStream As Object
145 Set objStream = CreateObject("ADODB.Stream")
146 For i = 0 To UBound(strTempFilePath)
147 'UTF-8のファイルを読み込む
148 With objStream
149 .Charset = "UTF-8"
150 .Type = 2 '(1:バイナリ 2:テキスト)
151 .Open
152 .LoadFromFile strTempFilePath(i)
153 strOutFile(i) = .ReadText
154 .Close
155 End With
156 Next i
157 Set objStream = Nothing
158 '△
159
160 Else
161
162 '▽② 標準出力のテキストを読み込む。
163 Dim strInput As String
164 Dim lFileNo As Long
165 For i = 0 To UBound(strTempFilePath)
166 lCnt = 0
167 lFileNo = FreeFile
168 Open strTempFilePath(i) For Input As #lFileNo
169 Do Until EOF(lFileNo)
170 Line Input #lFileNo, strInput
171 If lCnt = 0 Then
172 strOutFile(i) = Trim(strInput)
173 Else
174 strOutFile(i) = strOutFile(i) & _
175 vbCrLf & Trim(strInput)
176 End If
177 lCnt = lCnt + 1
178 Loop
179 Close #lFileNo
180 Next i
181 '△
182
183 End If
184
185 '▼一時ファイルの削除
186 For i = 0 To UBound(strTempFilePath)
187 Kill strTempFilePath(i)
188 Next i
189
190 Exit Function
191 Err_RunCommandLineEX:
192 strOutErrMsg = "(RunCommandLine) Runtime Error :" & _
193 Err.Number & vbCrLf & Err.Description & vbCrLf & _
194 vbCrLf & "Command=" & strCmd
195 RunCommandLineEX = False
196 End Function
Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
001 Option Explicit
002
003 '======================================================================
004 '
005 ' 名称 ：OSのプリンターを全て取得
006 ' 機能 ：OSのプリンターを取得して、strPrinterName()配列に返す。
007 ' strPrinterName(0)には「通常使うプリンター」がセットされる。
008 ' strPrinterName(1)以上にそれ以外はプリンターがセットされる。
009 ' バージョン：1.0
010 ' 作成日 ：2017/08/19 初版
011 ' URL ：https://pdf-file.nnn2.com/?p=1012
012 '
013 '======================================================================
014
015 Public Function nnn2GetAllPrinters( _
016 ByRef strPrinterName() As String) As Boolean
017
018 nnn2GetAllPrinters = True
019 On Error GoTo Err_nnn2GetAllPrinters:
020
021 ReDim strPrinterName(10) As String
022 Dim varWMIService As Variant
023 Dim varPS As Variant
024 Dim objPrinter As Object
025 Dim i As Long
026 i = 0
027 strPrinterName(0) = ""
028 strPrinterName(1) = ""
029 Set varWMIService = CreateObject("winmgmts:{impersonationLevel=impersonate}!¥¥.¥root¥cimv2")
030 Set varPS = varWMIService.ExecQuery("Select * from Win32_Printer")
031 For Each objPrinter In varPS
032 If objPrinter.Default Then
033 '通常使うプリンターを取得
034 strPrinterName(0) = objPrinter.Caption
035 Else
036 i = i + 1
037 strPrinterName(i) = objPrinter.Caption
038 End If
039 Next
040 ReDim Preserve strPrinterName(i) As String
041 Exit Function
042
043 Err_nnn2GetAllPrinters:
044 MsgBox "nnn2GetAllPrinters " & vbCrLf & _
045 Err.Description, vbCritical, "Runtime Error"
046 nnn2GetAllPrinters = False
047 End Function
Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
備考
- 「undll32.exe printui.dll,PrintUIEntry」コマンドはエラーが発生するとデスクトップ画面上にUI画面を表示してしまう。つまりプログラミングの処理がそこで中断してしまう。よって、出来る限りの事前チェックを行わなければならない。
参照
- 関数：OSのプリンターを全て取得
- 関数：コマンドラインを実行
- Rundll32 の printui.dll,PrintUIEntry
上記コマンドのパラメータや使い方を説明したMiscrosoftサイトの技術ページ - Rundll32 printui.dll, printuientry(日本語での解説)
＜ サンプル/関数 ＞