関数：通常使うプリンターを設定

概要

Windows の通常使うプリンター（デフォルトプリンター）を変更します。

機能

以下のコマンドを使って、Windowsの通常使うプリンターを変更します。 rundll32.exe printui.dll,PrintUIEntry /y /n "プリンター名"
以下の操作をVBAプログラミングでコマンドライン実行したと同じことを行います。

形式

001 [Boolean] = SetDefaultPrinter( _
002     sDefaultPrinter As String, _
003     sErrMsg As String) As Boolean

引数

第一引数 ( sDefaultPrinter As String ) :
通常使うプリンター名をセットします。
第二引数 ( sErrMsg As String ) :
エラー時にエラーメッセージがセットされます。

戻り値

True : 正常終了。
False : エラー有り。第二引数のsErrMsgにエラーメッセージがセットされます。

サンプル

通常使うプリンター名を「Adobe PDF」に設定します。

※思ったほど、簡単では無い。本気でやると。

Download：sample-SetDefaultPrinter.xls

001 Option Explicit
002 
003 '**************************************************
004 '
005 '   テスト用メインルーチン
006 '
007 '   処理内容：
008 '       通常使うプリンター名を"Adobe PDF"に設定する。
009 '
010 '**************************************************
011 
012 Sub Test_Main()
013     Dim bRet        As Boolean
014     Dim sErrMsg     As String
015     bRet = SetDefaultPrinter("Adobe PDF", sErrMsg)
016     Debug.Print "SetDefaultPrinter.bRet = " & bRet
017     MsgBox sErrMsg & vbCrLf & "bRet = (" & bRet & ")" & vbCrLf & Now
018 End Sub
019 
020 
021 '**************************************************
022 '
023 ' 通常使うプリンターを変更
024 '
025 ' 機能    : 通常使うプリンターを設定する。
026 '           既に設定されているとエラーで返す。
027 '           存在しないプリンター名はエラーで返す。
028 '
029 ' Create  : 2017/09/02
030 ' Update  :
031 ' Vertion : 1.0
032 '
033 ' 第１引数：sDefaultPrinter As String  (In)
034 '           コマンドライン
035 ' 第２引数：sErrMsg As String  (Out)
036 '           エラーメッセージ
037 '
038 ' 戻り値  : True:正常終了  False:エラー発生
039 '
040 ' 備考    : 他の関数も使用している。
041 ' URL     : http://pdf-file.nnn2.com/?p=1018
042 ' その他  : 著作権等は主張しません。
043 '           上記URLにコメントを頂けると嬉しいです。
044 '
045 '**************************************************
046 
047 Private Function SetDefaultPrinter( _
048     ByVal sDefaultPrinter As String, _
049     ByRef sErrMsg As String) As Boolean
050     
051     If Trim$(sDefaultPrinter) = "" Then
052         'エラー：Not Found Printer name
053         SetDefaultPrinter = False
054         sErrMsg = "エラー：SetDefaultPrinter" & vbCrLf & _
055             "プリンター名がセットされてない。"
056         Exit Function
057     End If
058     
059     Dim i               As Long
060     Dim bRet            As Boolean
061     Dim strOutFile1()   As String
062     Dim strOutFile2()   As String
063     
064     '引数で使う変数
065     Dim strCmd          As String
066     Dim strOutFile(1)   As String
067     Dim strErr          As String
068     Dim strWorkFolder   As String
069     Dim lRetCode        As Long
070     Dim lErrCount       As Long
071     Dim lErrCode(0)     As Long
072     
073     Dim strPrinterName() As String
074     Const CON_FOUND = 99999
075     
076     'PCに登録されているプリンター名を全て取得する
077     bRet = nnn2GetAllPrinters(strPrinterName)
078     
079     If sDefaultPrinter = strPrinterName(0) Then
080         '警告：It is already set.
081         SetDefaultPrinter = False
082         sErrMsg = "警告：SetDefaultPrinter" & vbCrLf & _
083             "既に通常使うプリンターにセット済みです。" & vbCrLf & _
084             "(" & sDefaultPrinter & ")"
085         Exit Function
086     End If
087     For i = 1 To UBound(strPrinterName)
088         If sDefaultPrinter = strPrinterName(i) Then
089             '同じプリンター名が見つかった
090             i = CON_FOUND
091             Exit For
092         End If
093     Next i
094     If i <> CON_FOUND Then
095         'エラー：This printer name does not exist.
096         SetDefaultPrinter = False
097         sErrMsg = "エラー：SetDefaultPrinter" & vbCrLf & _
098             "このプリンター名は存在しない。" & vbCrLf & _
099             "(" & sDefaultPrinter & ")"
100         Exit Function
101     End If
102     
103     '終了コードのセット
104     lErrCode(0) = 0
105     lErrCount = UBound(lErrCode)
106     strCmd = "rundll32.exe printui.dll,PrintUIEntry /y /n """ _
107          & sDefaultPrinter & """"
108     
109     'コマンドラインの実行
110     bRet = RunCommandLineEX(strCmd, strWorkFolder, _
111         lErrCount, lErrCode, _
112         strOutFile, strErr, lRetCode)
113             
114     sErrMsg = strErr
115     SetDefaultPrinter = bRet
116     
117 '    '実行結果の表示
118 '    Debug.Print "bRet=" & bRet
119 '    Debug.Print "lRetCode=" & lRetCode
120 '    strOutFile1 = Split(strOutFile(0), vbCrLf)
121 '    strOutFile2 = Split(strOutFile(1), vbCrLf)
122 '    Debug.Print "strErr=" & strErr
123 '    For i = 0 To UBound(strOutFile1)
124 '        Debug.Print "msg1 i(" & i & ")="; strOutFile1(i)
125 '    Next i
126 '    For i = 0 To UBound(strOutFile2)
127 '        Debug.Print "msg2 i(" & i & ")="; strOutFile2(i)
128 '    Next i
129 
130 End Function

　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     : 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編)
　

備考

「rundll32.exe printui.dll,PrintUIEntry /y /n "プリンター名"」でプリンター名を間違えると以下のエラー画面が表示されてしまいます。これが表示されるとプログラムの処理が中断してしまいます。そこで表示されないように事前にチェックして存在しないプリンター名はエラーにします。
「rundll32.exe printui.dll,PrintUIEntry /?」で他のパラメータのヘルプが表示されます。

参照

関数：OSのプリンターを全て取得
関数：コマンドラインを実行
Rundll32 の printui.dll,PrintUIEntry
コマンドのパラメータや使い方を説明したMiscrosoftサイトの技術ページ。

＜　サンプル/関数　＞

「関数：通常使うプリンターを設定」への2件のフィードバック

若原＊＊ より:

2022年11月22日 2:51 PM

複写帳票の印刷にドットプリンタを使用していて、印刷部分だけはF-Basicで造りましたが、｢標準のプリンタ｣にしか出力できず、印刷の前後に｢標準プリンタを切り替えましたか？｣とメッセージを出して、そのたびにデバイスとプリンタを開いて切り替えていました。こちらのライブラリを使用させていただくことで、印刷前にドットプリンタに切り替え、印刷後元に戻すという処理が自動でできるようになり大変助かります。どうもありがとうございます。
Windouws10＋excel2019(＋F-basic/96)
管理人 より:

2022年11月22日 5:31 PM

若原さん　はじめまして。
お役に立って、嬉しいです。 (^_^)

コメントを残す

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

コメント ※

名前 ※

メール ※

サイト

CAPTCHA

上に表示された文字を入力してください。

★　文章での質問は難しいですよネ。でも、早く解決して、家に帰りたい。

SAMURAI Plugin

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

OS名バージョン
Acrobat バージョン
ツール(Excel等) バージョン

コメントにサンプルコードを入れる時はコードを全て全角文字列にしてください。コチラで半角に戻します。それでもエラーが回避できない時はコメント下さい。個別に対処します。

お仕事で当サイトを見ている方へ
考え込んだら、ご質問下さい。
一緒に解決策を考えましょう。

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

概要

機能

形式

引数

戻り値

サンプル

備考

参照

「関数：通常使うプリンターを設定」への2件のフィードバック

コメントを残す

VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する