TOP > デフォルトプリンタを一時的に変更する方法      [...]

---

Acrobat OLE(IAC)オブジェクトの AVDoc オブジェクト には各種の印刷関連メソッドが提供されています。

しかし、出力先プリンタの指定は出来ません。

出力先プリンタはデフォルトプリンタ（=通常使うプリンタに指定）とメソッドで条件が決まっています。

そこで一時的にデフォルトプリンタ（=通常使うプリンタに指定）を変更する Excel VBA ＋ VB6.0 ロジックをココに公開します。

サンプル「関数：通常使うプリンターを設定」を御覧ください。 当記事の内容はかなり古く、こうゆうやり方でも出来ますよ、程度に公開を続けます。

 

▼サンプルのダウンロード▼

ChangePrinter105.zip

注意：ReadMe.txtファイルを読んでから使用して下さい。

  

---

▼サンプルのソース内容 ： ChangePrinter105.xls のみ▼

 

001 Option Explicit 002 003 Public Declare Sub Sleep Lib "kernel32" _ 004 (ByVal dwMilliseconds As Long) 005 006 Sub ボタン1_Click() 007 008 Dim strChangePrinter As String 009 010 '★以下のステートメントは随時変更する必要が有る★ 011 strChangePrinter = Worksheets("Sheet1").Cells(4, 5) 012 'strChangePrinter = "Canon BJ S600" 013 014 If vbOK <> MsgBox("デフォルトプリンタを以下に変更してよいですか？" _ 015 & vbCrLf & vbCrLf & "(" & strChangePrinter & ")" _ 016 & vbCrLf & vbCrLf & "上記プリンタに印刷してもよいですか？", _ 017 vbOKCancel + vbDefaultButton1 + _ 018 vbQuestion + vbApplicationModal, _ 019 "確認") Then 020 Exit Sub 021 End If 022 023 '▼デフォルトプリンタの変更 024 If funChangePrinter(strChangePrinter) = False _ 025 Then Exit Sub 026 027 '▼PDFの印刷 028 029 'Acrobatオブジェクトの定義＆作成 030 031 'Acrobat 4,5,6の時 032 ' Dim objAcroApp As Acrobat.CAcroApp 033 ' Dim objAcroAVDoc As Acrobat.CAcroAVDoc 034 ' Set objAcroApp = CreateObject("AcroExch.App") 035 ' Set objAcroAVDoc = CreateObject("AcroExch.AVDoc") 036 037 'Acrobat 7,8,9の時 038 Dim objAcroApp As New Acrobat.AcroApp 039 Dim objAcroAVDoc As New Acrobat.AcroAVDoc 040 041 '以降はAcrobat全て共通 042 Dim lRet As Long '戻り値 043 044 'Acrobatアプリケーションを起動する。 045 lRet = objAcroApp.Show 046 'PDFファイルを開いて表示する。 047 lRet = objAcroAVDoc.Open("C:\work\Test01.pdf", "") 048 'PDFファイルの頁を指定して印刷する。 049 lRet = objAcroAVDoc.PrintPages(0, 0, 2, 0, 0) 050 'PDFファイルを閉じます。 051 lRet = objAcroAVDoc.Close(1) 052 'Acrobatアプリケーションを終了する。 053 lRet = objAcroApp.Hide 054 lRet = objAcroApp.Exit 055 'オブジェクトを強制解放する 056 Set objAcroAVDoc = Nothing 057 Set objAcroApp = Nothing 058 059 '▼デフォルトプリンタの変更（元に戻す） 060 If funChangePrinter("Brother DCP-535CN Printer") = False _ 061 Then Exit Sub 062 063 '▼正常終了のメッセージ 064 MsgBox "処理は正常終了しました", _ 065 vbInformation + vbSystemModal 066 067 End Sub 068 069 Public Function funChangePrinter _ 070 (ByVal strPrinterName As String) As Boolean 071 072 Dim strAppPath As String 'Excelワークブックのフルパス 073 Dim verRet 'Shell関数の戻り値 074 Dim strCmd As String 'コマンドライン 075 Dim strLogFile As String 'LOGファイル名 076 Dim strLogFilePath As String 'フルパス 077 Dim strChangePrinter As String '変更するプリンタ名 078 Dim i As Long '添え字 079 080 funChangePrinter = False 081 082 'アプリの監視MAX 60秒 083 Const CON_MAX As Long = 60 084 '起動アプリケーション名 085 Const CON_APP As String = "ChangePrinter105.exe" 086 087 '★以下のステートメントは随時変更する必要が有る★ 088 strChangePrinter = strPrinterName 089 090 'Excelワークシートの実行フルパスを取得 091 strAppPath = Application.ActiveWorkbook.Path & "\" 092 093 '環境の事前チェック 094 If Dir(strAppPath & CON_APP) = "" Then 095 MsgBox "起動アプリケーション(" & CON_APP & ")が" _ 096 & "存在しません", _ 097 vbCrLf & vbCrLf & "処理は中断しました", _ 098 vbCritical + vbSystemModal, "実行エラー" 099 Exit Function 100 End If 101 102 '▼「デフォルトプリンタの変更」アプリケーションの起動 103 'ログファイルの命名 104 Randomize '乱数の初期化 105 strLogFile = Format(Date, "YYYYMMDD") & _ 106 Format(Time(), "HHMMSS") & "-" & _ 107 Format(Int((9999 * Rnd) + 1), "0000") _ 108 & ".log" 109 110 'コマンド内容の作成 111 strCmd = strAppPath & CON_APP & " " & _ 112 strChangePrinter & "," & strLogFile 113 'アプリ起動 (非同期的で実行) 114 verRet = Shell(strCmd, vbHide) 115 116 '▼起動アプリケーションの完了を監視する 117 strLogFilePath = strAppPath & strLogFile 118 For i = 1 To CON_MAX 119 Sleep 1000 120 DoEvents 121 If Dir(strLogFilePath) <> "" Then 122 '起動アプリケーションの終了を検知した 123 Exit For 124 End If 125 Next i 126 If i >= CON_MAX Then 127 MsgBox "起動アプリケーションは監視でタイムアウトになりました" & _ 128 vbCrLf & vbCrLf & "処理を中断します", _ 129 vbCritical + vbSystemModal, "実行エラー" 130 '不要ファイルの削除 131 Kill strLogFilePath 132 Exit Function 133 End If 134 135 'テキストファイルの書込み時間分待つ 136 Sleep 500 137 '不要ファイルの削除 138 Kill strLogFilePath 139 140 '正常終了 141 funChangePrinter = True 142 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

---

サンプルのソース内容 ： ChangePrinter105.exe： のみ

001 Private Sub cmdEnd_Click() 002 '画面を閉じる 003 Unload Me 004 End Sub 005 006 Private Sub Command1_Click() 007 'デフォルトプリンタ変更画面を表示 008 Load Form1 009 Form1.Show 010 '自画面を閉じる 011 Unload Me 012 End Sub 013 014 Private Sub Form_Load() 015 Form2.Caption = CStr(App.EXEName) & " 引数の使い方 " & strVersion 016 Label1.Caption = "ChangePrinter プリンター名 , ﾃｷｽﾄﾌｧｲﾙ.log" & vbCrLf _ 017 & "ChangePrinter /DP" & vbCrLf _ 018 & "ChangePrinter /AL" & vbCrLf _ 019 & "ChangePrinter /C" & vbCrLf & vbCrLf _ 020 & "・デフォルトプリンター変更の例：Canon BJ S600 , end.log" & vbCrLf _ 021 & "・/DP：デフォルトプリンター名のファイル(DefPrinter.txt)の出力" & vbCrLf _ 022 & "・/AL：プリンター名一覧ファイル(AllPrinter.txt)の出力" & vbCrLf _ 023 & "・/C ：デフォルトプリンタの変更画面を表示" & vbCrLf _ 024 & "・/? ：当引数説明画面の表示" 025 End Sub 026

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

001 Private Sub Form_Load() 002 Dim r As Long '戻り値 003 Dim Buffer As String 'バッファ 004 Dim i As Long '添え字 005 006 ' Get the list of available printers from WIN.INI 007 Buffer = Space(8192) 008 r = GetProfileString("PrinterPorts", vbNullString, "", _ 009 Buffer, Len(Buffer)) 010 011 ' Display the list of printer in the ListBox List1 012 ParseList List1, Buffer 013 014 Form1.Caption = Form1.Caption & " " & strVersion 015 Label1.Caption = vbNullString 016 017 If List1.ListCount = 0 Then 018 'プリンタが登録されて無い 019 Command1.Enabled = False 020 Exit Sub 021 End If 022 023 'デフォルトプリンタを選択状態にする 024 For i = 0 To List1.ListCount - 1 025 If List1.List(i) = Printer.DeviceName Then 026 List1.ListIndex = i 027 Exit For 028 End If 029 Next i 030 031 End Sub 032 033 Private Sub Form_Unload(Cancel As Integer) 034 'アプリケーションの終了 035 End 036 End Sub 037 038 Private Sub Command1_Click() 039 Dim osinfo As OSVERSIONINFO 040 Dim retvalue As Integer 041 042 'リストボックスが選択状態に無い時はスキップ 043 If List1.Text = "" Then Exit Sub 044 045 '作業中はボタン類を使用不可にする 046 Command1.Enabled = False 047 Command2.Enabled = False 048 'マウスポインターを砂時計にする 049 Me.MousePointer = vbHourglass 050 Label1.Caption = "デフォルトプリンタの変更中..." 051 Me.Refresh 052 053 If List1.Text = Printer.DeviceName Then 054 GoTo Command1_Skip: 055 End If 056 057 osinfo.dwOSVersionInfoSize = 148 058 osinfo.szCSDVersion = Space$(128) 059 retvalue = GetVersionExA(osinfo) 060 061 gstrChangePrinterName = List1.Text 062 063 'デフォルトプリンタの変更 064 If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then 065 'Widnows 95/98 066 Call Win95SetDefaultPrinter 067 Else 068 'This assumes that future versions of Windows 069 'use the NT method 070 Call WinNTSetDefaultPrinter 071 End If 072 073 Command1_Skip: 074 'ボタン類を使用可能にする 075 Command1.Enabled = True 076 Command2.Enabled = True 077 Label1.Caption = "デフォルトプリンタの変更は完了しました" 078 'マウスポインターをデフォルトに戻す 079 Me.MousePointer = vbDefault 080 End Sub 081 082 Private Sub Command2_Click() 083 '画面を閉じる 084 Unload Me 085 End Sub

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

▼ Module1.basの内容 ▼

001 Attribute VB_Name = "Module1" 002 Option Explicit 003 004 '====================================================== 005 ' 006 '【機能】引数よりデフォルトプリンタを変更する。 007 ' 引数より以下の情報をテキストファイルで出力する。 008 ' 1)デフォルトプリンタを変更する 009 ' 2)デフォルトプリンタを出力 010 ' 3)プリンタ一覧を出力 011 ' 012 '【作成者】https://pdf-file.nnn2.com/ サイト管理人 013 ' 014 '【作成日】2010/08/31 (初版) 015 ' 016 '【引数：例】 017 ' 018 '【備考】1)以下のURLからメイン・ロジックを引用しました。 019 ' http://support.microsoft.com/kb/266767/ja 020 ' 2)多重起動可能チェックはしない。 021 ' 3)単体でも、他アプリからのコマンドライン起動でも 022 ' 使用出来るように設計してある。 023 ' 4)引数の設定形式は固定とする。 024 ' ・ﾌﾟﾘﾝﾀ名 , 処理完了を知らせるﾃｷｽﾄﾌｧｲﾙ名 025 ' ・ﾌﾟﾘﾝﾀ名 026 ' ・/DP 027 ' ・/AL 028 ' ・/C 029 ' ・/? 030 ' ・無し 031 '====================================================== 032 033 'ブロードキャスト（全てのトップレベルウインドウ） 034 Public Const HWND_BROADCAST = &HFFFF 035 'Windowsの初期化ファイルの更新を反映 036 Public Const WM_WININICHANGE = &H1A 037 038 ' constants for DEVMODE structure 039 Public Const CCHDEVICENAME = 32 040 Public Const CCHFORMNAME = 32 041 042 ' constants for DesiredAccess member of PRINTER_DEFAULTS 043 Public Const STANDARD_RIGHTS_REQUIRED = &HF0000 044 Public Const PRINTER_ACCESS_ADMINISTER = &H4 045 Public Const PRINTER_ACCESS_USE = &H8 046 Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED _ 047 Or PRINTER_ACCESS_ADMINISTER _ 048 Or PRINTER_ACCESS_USE) 049 050 ' constant that goes into PRINTER_INFO_5 Attributes member 051 ' to set it as default 052 Public Const PRINTER_ATTRIBUTE_DEFAULT = 4 053 054 ' Constant for OSVERSIONINFO.dwPlatformId 055 Public Const VER_PLATFORM_WIN32_WINDOWS = 1 056 057 Public Type OSVERSIONINFO 058 dwOSVersionInfoSize As Long '構造体のバイト数 059 dwMajorVersion As Long 'メジャーバージョン番号 060 dwMinorVersion As Long 'マイナーバージョン番号 061 dwBuildNumber As Long 'ビルド番号 062 dwPlatformId As Long 'プラットフォームのID 063 szCSDVersion As String * 128 'OSに関する付加情報 064 End Type 065 066 Public Type DEVMODE 067 dmDeviceName As String * CCHDEVICENAME 068 dmSpecVersion As Integer 069 dmDriverVersion As Integer 070 dmSize As Integer 071 dmDriverExtra As Integer 072 dmFields As Long 073 dmOrientation As Integer 074 dmPaperSize As Integer 075 dmPaperLength As Integer 076 dmPaperWidth As Integer 077 dmScale As Integer 078 dmCopies As Integer 079 dmDefaultSource As Integer 080 dmPrintQuality As Integer 081 dmColor As Integer 082 dmDuplex As Integer 083 dmYResolution As Integer 084 dmTTOption As Integer 085 dmCollate As Integer 086 dmFormName As String * CCHFORMNAME 087 dmLogPixels As Integer 088 dmBitsPerPel As Long 089 dmPelsWidth As Long 090 dmPelsHeight As Long 091 dmDisplayFlags As Long 092 dmDisplayFrequency As Long 093 dmICMMethod As Long '// Windows 95 only 094 dmICMIntent As Long '// Windows 95 only 095 dmMediaType As Long '// Windows 95 only 096 dmDitherType As Long '// Windows 95 only 097 dmReserved1 As Long '// Windows 95 only 098 dmReserved2 As Long '// Windows 95 only 099 End Type 100 101 Private Type PRINTER_INFO_5 102 pPrinterName As String 103 pPortName As String 104 Attributes As Long 105 DeviceNotSelectedTimeout As Long 106 TransmissionRetryTimeout As Long 107 End Type 108 109 Public Type PRINTER_DEFAULTS 110 pDatatype As Long 111 pDevMode As Long 112 DesiredAccess As Long 113 End Type 114 115 Public Declare Function GetProfileString Lib "kernel32" _ 116 Alias "GetProfileStringA" _ 117 (ByVal lpAppName As String, _ 118 ByVal lpKeyName As String, _ 119 ByVal lpDefault As String, _ 120 ByVal lpReturnedString As String, _ 121 ByVal nSize As Long) As Long 122 123 'Win.iniファイルに文字列を書き込む 124 Private Declare Function WriteProfileString Lib "kernel32" _ 125 Alias "WriteProfileStringA" _ 126 (ByVal lpszSection As String, _ 127 ByVal lpszKeyName As String, _ 128 ByVal lpszString As String) As Long 129 130 'ウィンドウにメッセージを送信 131 Private Declare Function SendMessage Lib "user32" _ 132 Alias "SendMessageA" _ 133 (ByVal hwnd As Long, _ 134 ByVal wMsg As Long, _ 135 ByVal wParam As Long, _ 136 lparam As String) As Long 137 138 Public Declare Function GetVersionExA Lib "kernel32" _ 139 (lpVersionInformation As OSVERSIONINFO) As Integer 140 141 Private Declare Function OpenPrinter Lib "winspool.drv" _ 142 Alias "OpenPrinterA" _ 143 (ByVal pPrinterName As String, _ 144 phPrinter As Long, _ 145 pDefault As PRINTER_DEFAULTS) As Long 146 147 Private Declare Function SetPrinter Lib "winspool.drv" _ 148 Alias "SetPrinterA" _ 149 (ByVal hPrinter As Long, _ 150 ByVal Level As Long, _ 151 pPrinter As Any, _ 152 ByVal Command As Long) As Long 153 154 Private Declare Function GetPrinter Lib "winspool.drv" _ 155 Alias "GetPrinterA" _ 156 (ByVal hPrinter As Long, _ 157 ByVal Level As Long, _ 158 pPrinter As Any, _ 159 ByVal cbBuf As Long, _ 160 pcbNeeded As Long) As Long 161 162 Private Declare Function lstrcpy Lib "kernel32" _ 163 Alias "lstrcpyA" _ 164 (ByVal lpString1 As String, _ 165 ByVal lpString2 As Any) As Long 166 167 Private Declare Function ClosePrinter Lib "winspool.drv" _ 168 (ByVal hPrinter As Long) As Long 169 170 Private strPrintDeviceName(500) As String 171 Private strPrintDriverName(500) As String 172 Private strPrintPort(500) As String 173 Public gstrChangePrinterName As String 174 '※配列は500程度待たせて置く。実際こんなに多くは無いはず。 175 176 '**************************************************** 177 ' 178 '▼スタートアップ処理 179 ' 180 '**************************************************** 181 Sub Main() 182 183 'デフォルト・プリンタのファイル 184 Const CON_DEF_PRINTER_FILE = "DefPrinter.txt" 185 'プリンタ名一覧のファイル 186 Const CON_ALL_PRINTER_FILE = "AllPrinter.txt" 187 188 Dim strCmdLine() As String 'コマンドライン引数 189 Dim lFileNo As Long 'ファイル番号 190 Dim strAppPath As String 'アプリケーションの実行パス 191 Dim strVersion As String 192 Dim strOutputText(5) As String '出力テキスト 193 Dim strCmdLine_1 As String 'コマンドライン引数1 194 Dim strCmdLine_2 As String 'コマンドライン引数2 195 Dim prtObj As Printer 'プリンターオブジェクト 196 Dim bCheck As Boolean 197 Dim i As Long '添え字 198 Dim j As Long '添え字 199 200 '初期化 201 j = -1 202 For i = LBound(strOutputText) To UBound(strOutputText) - 1 203 strOutputText(i) = vbNullString 204 Next i 205 For i = LBound(strPrintPort) To UBound(strPrintPort) - 1 206 strPrintDeviceName(i) = vbNullString 207 strPrintDriverName(i) = vbNullString 208 strPrintPort(i) = vbNullString 209 Next i 210 strAppPath = App.Path & "\" 211 212 '▼開始時間のテキスト出力 213 j = j + 1 214 strOutputText(j) = _ 215 "START " & Format(Date, "YYYY/MM/DD") & _ 216 " " & Format(Time(), "HH:MM:SS") 217 218 'コマンドライン引数を配列に格納 219 strCmdLine = Split(Command(), ",") 220 221 '▼引数の存在チェックをする 222 If UBound(strCmdLine) = -1 Then 223 '引数が無い ※テスト済み 224 '表示する 225 Form2.Show vbModeless 226 Exit Sub 227 End If 228 229 '▼コマンドライン引数を変数に格納 230 If UBound(strCmdLine) = 0 Then 231 strCmdLine_1 = Trim$(strCmdLine(0)) 232 ElseIf UBound(strCmdLine) = 1 Then 233 strCmdLine_1 = Trim$(strCmdLine(0)) 234 strCmdLine_2 = Trim$(strCmdLine(1)) 235 Else 236 strCmdLine_1 = Trim$(strCmdLine(0)) 237 strCmdLine_2 = Trim$(strCmdLine(1)) 238 '第三引数は無視 239 End If 240 241 If strCmdLine_2 <> vbNullString Then 242 j = j + 1 243 strOutputText(j) = _ 244 "CMD " & Format(Date, "YYYY/MM/DD") & _ 245 " " & Format(Time(), "HH:MM:SS") & _ 246 " " & strCmdLine_1 & _ 247 " , " & strCmdLine_2 248 End If 249 250 '▼引数紹介画面を表示するか？ 251 If strCmdLine_1 = "/?" Or strCmdLine_1 = "-?" Then 252 '表示する 253 Form2.Show vbModeless 254 Exit Sub 255 End If 256 257 '▼デフォルトプリンタの変更画面を表示するか？ 258 If strCmdLine_1 = "/C" Or strCmdLine_1 = "/c" Then 259 '表示する 260 Form1.Show vbModal 261 Exit Sub 262 End If 263 264 '▼デフォルトプリンタ名と引数の変更プリンタ名が同じなら 265 ' 再度変更処置は行わない。※高速化、トラブル回避の為 266 If strCmdLine_1 = Printer.DeviceName Then 267 j = j + 1 268 strOutputText(j) = _ 269 "SKIP " & Format(Date, "YYYY/MM/DD") & _ 270 " " & Format(Time(), "HH:MM:SS") & _ 271 " " & strCmdLine_1 272 GoTo Exit_Main: 273 End If 274 275 '▼パソコンにインストールしてあるプリンタ一覧の作成 276 'プリンタの一覧作成 277 i = -1 278 For Each prtObj In Printers 279 i = i + 1 280 strPrintDeviceName(i) = prtObj.DeviceName 281 strPrintDriverName(i) = prtObj.DriverName 282 strPrintPort(i) = prtObj.Port 283 Next 284 285 '▼プリンタ名一覧のファイル出力 286 If strCmdLine_1 = "/AL" Or strCmdLine_1 = "/al" Then 287 '使用可能なファイル番号を出す 288 lFileNo = FreeFile() 289 ' ファイル名を作成します。 290 Open strAppPath & CON_ALL_PRINTER_FILE For Output As #lFileNo 291 292 For i = LBound(strPrintPort) To UBound(strPrintPort) - 1 293 If strPrintPort(i) = vbNullString Then Exit For 294 ' 文字列を出力します。 295 Print #lFileNo, strPrintDeviceName(i) & "," & _ 296 strPrintDriverName(i) & "," & _ 297 strPrintPort(i) 298 Next i 299 ' ファイルを閉じます。 300 Close #lFileNo 301 GoTo Exit_Main: 302 End If 303 304 '▼デフォルト・プリンター名のファイル出力 305 If strCmdLine_1 = "/DP" Or strCmdLine_1 = "/dp" Then 306 '使用可能なファイル番号を出す 307 lFileNo = FreeFile() 308 ' ファイル名を作成します。 309 Open strAppPath & CON_DEF_PRINTER_FILE For Output As #lFileNo 310 ' 文字列を出力します。 311 Print #lFileNo, Printer.DeviceName & "," & _ 312 Printer.DriverName & "," & _ 313 Printer.Port 314 ' ファイルを閉じます。 315 Close #lFileNo 316 GoTo Exit_Main: 317 End If 318 319 '▼引数が一覧に存在するかのチェック 320 bCheck = False 321 For i = LBound(strPrintPort) To UBound(strPrintPort) - 1 322 If strPrintDeviceName(i) = vbNullString Then Exit For 323 If strPrintDeviceName(i) = strCmdLine_1 Then 324 '一覧に合った。問題無し。 325 bCheck = True 326 Exit For 327 End If 328 Next i 329 If bCheck = False Then 330 '引数の記述が間違っている ？テスト済み 331 MsgBox "引数のプリンター名が間違っています。" & vbCrLf & _ 332 "(" & strCmdLine_1 & ")", _ 333 vbOKOnly + vbDefaultButton1 + vbCritical + vbSystemModal, _ 334 CStr(App.EXEName) & " " & strVersion & " エラー" 335 'エラーで処理を中断する 336 GoTo Exit_Main: 337 End If 338 339 '▼アプリケーションの終了処理 340 If strCmdLine_2 <> vbNullString Then 341 j = j + 1 342 strOutputText(j) = _ 343 "SET " & Format(Date, "YYYY/MM/DD") & _ 344 " " & Format(Time(), "HH:MM:SS") & _ 345 " (" & strCmdLine(0) & ")" 346 End If 347 348 '▼デフォルト・プリンターを変更する 349 gstrChangePrinterName = strPrintDeviceName(i) 350 351 Dim osinfo As OSVERSIONINFO 352 Dim retvalue As Integer 353 354 osinfo.dwOSVersionInfoSize = 148 355 osinfo.szCSDVersion = Space$(128) 356 retvalue = GetVersionExA(osinfo) 357 358 If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then 359 ' Windows 95/98 360 Call Win95SetDefaultPrinter 361 Else 362 ' This assumes that future versions of Windows 363 ' use the NT method 364 Call WinNTSetDefaultPrinter 365 End If 366 367 Exit_Main: 368 369 '▼アプリケーションの終了処理 370 If strCmdLine_2 <> vbNullString Then 371 372 On Error Resume Next 373 374 j = j + 1 375 strOutputText(j) = _ 376 "END " & Format(Date, "YYYY/MM/DD") & _ 377 " " & Format(Time(), "HH:MM:SS") 378 379 '使用可能なファイル番号を出す 380 lFileNo = FreeFile() 381 ' ファイル名を作成します。 382 Open strAppPath & strCmdLine_2 For Output As lFileNo 383 ' 終了情報を出力します。 384 For i = LBound(strOutputText) To UBound(strOutputText) - 1 385 If strOutputText(i) = vbNullString Then Exit For 386 Print #lFileNo, strOutputText(i) 387 Next i 388 ' ファイルを閉じます。 389 Close #lFileNo 390 391 '※このファイルの存在で当アプリが処理を終了したかの 392 '※判断が出来る 393 End If 394 395 'アプリケーションの終了 396 End 397 398 End Sub 399 400 Public Sub SelectPrinter(NewPrinter As String) 401 Dim Prt As Printer 402 403 For Each Prt In Printers 404 If Prt.DeviceName = NewPrinter Then 405 Set Printer = Prt 406 Exit For 407 End If 408 Next 409 End Sub 410 411 Public Function PtrCtoVbString(Add As Long) As String 412 Dim sTemp As String * 512 413 Dim x As Long 414 415 x = lstrcpy(sTemp, Add) 416 If (InStr(1, sTemp, Chr(0)) = 0) Then 417 PtrCtoVbString = "" 418 Else 419 PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1) 420 End If 421 End Function 422 423 Public Sub SetDefaultPrinter _ 424 (ByVal PrinterName As String, _ 425 ByVal DriverName As String, _ 426 ByVal PrinterPort As String) 427 428 Dim DeviceLine As String 429 Dim r As Long 430 Dim l As Long 431 432 DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort 433 ' Store the new printer information in the [WINDOWS] section of 434 ' the WIN.INI file for the DEVICE= item 435 r = WriteProfileString("windows", "Device", DeviceLine) 436 ' Cause all applications to reload the INI file: 437 l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows") 438 End Sub 439 440 Public Sub Win95SetDefaultPrinter() 441 Dim Handle As Long 'handle to printer 442 Dim PrinterName As String 443 Dim pd As PRINTER_DEFAULTS 444 Dim x As Long 445 Dim need As Long 'bytes needed 446 Dim pi5 As PRINTER_INFO_5 'your PRINTER_INFO structure 447 Dim LastError As Long 448 449 ' determine which printer was selected 450 PrinterName = gstrChangePrinterName 451 ' none － exit 452 If PrinterName = "" Then 453 Exit Sub 454 End If 455 456 ' set the PRINTER_DEFAULTS members 457 pd.pDatatype = 0& 458 pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess 459 460 ' Get a handle to the printer 461 x = OpenPrinter(PrinterName, Handle, pd) 462 ' failed the open 463 If x = False Then 464 'error handler code goes here 465 Exit Sub 466 End If 467 468 ' Make an initial call to GetPrinter, requesting Level 5 469 ' (PRINTER_INFO_5) information, to determine how many bytes 470 ' you need 471 x = GetPrinter(Handle, 5, ByVal 0&, 0, need) 472 ' don't want to check Err.LastDllError here － it's supposed 473 ' to fail 474 ' with a 122 － ERROR_INSUFFICIENT_BUFFER 475 ' redim t as large as you need 476 ReDim t((need \ 4)) As Long 477 478 ' and call GetPrinter for keepers this time 479 x = GetPrinter(Handle, 5, t(0), need, need) 480 ' failed the GetPrinter 481 If x = False Then 482 'error handler code goes here 483 Exit Sub 484 End If 485 486 ' set the members of the pi5 structure for use with SetPrinter. 487 ' PtrCtoVbString copies the memory pointed at by the two string 488 ' pointers contained in the t() array into a Visual Basic string. 489 ' The other three elements are just DWORDS (long integers) and 490 ' don't require any conversion 491 pi5.pPrinterName = PtrCtoVbString(t(0)) 492 pi5.pPortName = PtrCtoVbString(t(1)) 493 pi5.Attributes = t(2) 494 pi5.DeviceNotSelectedTimeout = t(3) 495 pi5.TransmissionRetryTimeout = t(4) 496 497 ' this is the critical flag that makes it the default printer 498 pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT 499 500 ' call SetPrinter to set it (Windows API) 501 x = SetPrinter(Handle, 5, pi5, 0) 502 503 If x = False Then ' SetPrinter failed 504 MsgBox "SetPrinter Failed. Error code: " & Err.LastDllError 505 Exit Sub 506 Else 507 If Printer.DeviceName <> gstrChangePrinterName Then 508 ' Make sure Printer object is set to the new printer 509 Call SelectPrinter(gstrChangePrinterName) 510 End If 511 End If 512 513 ' and close the handle (Windows API) 514 ClosePrinter (Handle) 515 End Sub 516 517 Public Sub GetDriverAndPort _ 518 (ByVal Buffer As String, _ 519 DriverName As String, _ 520 PrinterPort As String) 521 522 Dim iDriver As Integer 523 Dim iPort As Integer 524 525 DriverName = "" 526 PrinterPort = "" 527 528 ' The driver name is first in the string terminated by a comma 529 iDriver = InStr(Buffer, ",") 530 If iDriver > 0 Then 531 532 ' Strip out the driver name 533 DriverName = Left(Buffer, iDriver - 1) 534 535 ' The port name is the second entry after the driver name 536 ' separated by commas. 537 iPort = InStr(iDriver + 1, Buffer, ",") 538 539 If iPort > 0 Then 540 ' Strip out the port name 541 PrinterPort = Mid(Buffer, iDriver + 1, _ 542 iPort - iDriver - 1) 543 End If 544 End If 545 End Sub 546 547 Public Sub ParseList(lstCtl As Control, _ 548 ByVal Buffer As String) 549 550 Dim i As Integer 551 Dim s As String 552 553 Do 554 i = InStr(Buffer, Chr(0)) 555 If i > 0 Then 556 s = Left(Buffer, i - 1) 557 If Len(Trim(s)) Then lstCtl.AddItem s 558 Buffer = Mid(Buffer, i + 1) 559 Else 560 If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer 561 Buffer = "" 562 End If 563 Loop While i > 0 564 End Sub 565 566 Public Sub WinNTSetDefaultPrinter() 567 Dim Buffer As String 568 Dim DeviceName As String 569 Dim DriverName As String 570 Dim PrinterPort As String 571 Dim PrinterName As String 572 Dim r As Long 573 574 Buffer = Space(1024) 575 PrinterName = gstrChangePrinterName 576 r = GetProfileString("PrinterPorts", PrinterName, "", _ 577 Buffer, Len(Buffer)) 578 579 ' Parse the driver name and port name out of the buffer 580 Call GetDriverAndPort(Buffer, DriverName, PrinterPort) 581 582 If DriverName <> "" And PrinterPort <> "" Then 583 Call SetDefaultPrinter(gstrChangePrinterName, DriverName, PrinterPort) 584 If Printer.DeviceName <> gstrChangePrinterName Then 585 ' Make sure Printer object is set to the new printer 586 SelectPrinter (gstrChangePrinterName) 587 End If 588 End If 589 End Sub 590 591 '**************************************************** 592 '機能：VisualBasicプログラムのバージョン情報 593 '**************************************************** 594 Public Function strVersion() As String 595 With App 596 strVersion = "v" & .Major & _ 597 "." & .Minor & _ 598 "." & .Revision 599 End With 600 End Function

　Highlight：プログラミング言語のソースコードを構文で色分け (GUI編)
　

---

備考

1. 当サンプルはメイン部分が実用的ではありません。Excel VBAを修正して下さい。
   [Alt]+[F11]キーを同時に押下するとVBA開発環境画面が表示されます。
2. 動作確認は２つ
   1. WindowsXP(+SP3) + Office Excel 2003(+SP3) + Acrobat Pro 8.2.3
   2. Windows 98SE + Acrobat 4.0  ※プリンタの変更のみ
3. 上記以外でも動作を確認した方はコメントを頂けると助かります。
4. クラインパソコンだけでの使用でしたら、上記サンプルを参考で構いません。
   しかし、サーバーでの使用は並列稼動を阻止する必要があります。
   そこで Appオブジェクト のLockメソッドとUnlockメソッドを使用して、ロジックの同時走行を阻止する為の排他制御ロジックを入れて下さい。
   詳細は、LockメソッドとUnlockメソッドを参照して下さい。
5. パソコンのスペックや環境により変わると思いますが、デフォルトプリンタを変更するには４～６秒ほどの時間が掛かる場合があります。
6. 詳細はダウンロードファイルの中の「ReadMe.txt」ファイルに書いています。
   必ず目を通して下さい」。

注意事項

1. お決まり事ですが。
   当ロジックを使って生じたトラブル、責任、義務、その他の発生する事に関して、当サイトは一切を負いません。
   自分で動作確認をして、御使用下さい。
2. WindowsAPI に関する質問は御遠慮下さい。
   ※難しすぎて返答出来ません。

＜ TOPへ ＞