サンプル:印刷設定の変更と復元

TOP > サンプル / 関数 > *      [...]


love in Rio

概要

プリンタードライバーの印刷設定を一時的に変更し、処理が完了したら元の状態に戻します。

印刷設定はプログラミングでのレジストリ更新等では変更できません。
「undll32.exe printui.dll,PrintUIEntry」コマンドを使って更新を行います。

PrintPagesPrintPagesExPrintPagesSilentPrintPagesSilentEx でデフォルトプリンターを変更する必要が出てきた時に流用するサンプルです。

詳細

以下はプリンタードライバー「Adobe PDF」に対しての例です。

手動操作での事前作業:

  1. 目的のプリンタードライバー「Adobe PDF」の印刷設定を変更します。
  2. この変更後の印刷設定の内容を"henko.dat"に保存します。
    以下のコマンドをMS DOS画面で実行します。
    rundll32.exe printui.dll PrintUIEntry /Ss /n "Adobe PDF" /a "henko.dat"
  3. プリンタードライバーの印刷設定を変更前の状態に戻します。

プログラミング:

  1. プリンタードライバー「Adobe PDF」の現在の印刷設定の内容をファイルに保存します。
    以下のコマンドをMS DOS画面で実行します。
    rundll32.exe printui.dll PrintUIEntry /Ss /n "Adobe PDF" /a "fukugen.dat"
  2. 印刷設定を事前準備したファイルを使って更新します。
    以下のコマンドをMS DOS画面で実行します。※「/Sr」に注目。 rundll32.exe printui.dll PrintUIEntry /Sr /n "Adobe PDF" /a "henko.dat"
  3. プリンタードライバー「Adobe PDF」の印刷設定は変更されました。目的の処理をプログラミングで実行します。
  4. プリンタードライバー「Adobe PDF」の印刷設定を元に戻します。
    以下のコマンドをMS DOS画面で実行します。 rundll32.exe printui.dll PrintUIEntry /Ss /n "Adobe PDF" /a "fukugen.dat"

なお、2以降の処理はエラーが有っても必ず4を実行して終了する様にします。

サンプル

上記詳細のプログラミングに書いた手順でプリンタードライバー「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 : http://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 : http://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 ' 第1引数:strInCommand As String (In) 038 ' コマンドライン 039 ' 第2引数:strInWorkFolder As String (In) 040 ' 一時的な作業フォルダ 041 ' 第3引数:lInErrCount As Long (In) 042 ' 終了コードの数。 -1:無し 043 ' 第4引数:lInErrCode() As Long (In) 044 ' 終了コードの配列 045 ' 第5引数:strOutFile() As String (Out) 046 ' strOutFile(0):標準出力の内容 047 ' strOutFile(1):標準エラー出力の内容 048 ' 第6引数:strOutErrMsg As String (Out) 049 ' プログラム内のエラーメッセージ。エラー無しは ""。 050 ' 第7引数:lOutRetCode As Long (Out) 051 ' コマンドラインの終了コード 052 ' 053 ' 戻り値 : True:正常終了 False:エラー発生 054 ' 055 ' 備考 : 引数5,6,7の内容でエラー判定を行う。 056 ' URL : http://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 :http://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編)
 

備考

  1. 「undll32.exe printui.dll,PrintUIEntry」コマンドはエラーが発生するとデスクトップ画面上にUI画面を表示してしまう。つまりプログラミングの処理がそこで中断してしまう。よって、出来る限りの事前チェックを行わなければならない。

参照

< サンプル/関数 >

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

CAPTCHA


出来るだけ早く返答する様には心がけています。
が、遅くなる時もありますのでご了承ください。


SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れるとエラーになる場合が有ります。その時はコードの前後に <code> ・・・</code> タグを入れてください。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください