プリンターを切り替える : Excel(エクセル)

Excel Tipsメニューに戻る

スポンサーリンク



Excel VBAでPrintOutメソッドのActivePrinterを使用し、印刷するプリンタを切り替えます。
初めにプリンタ一覧を列挙し、マーク列が空白でないプリンタを使用し印刷します。

・プリンタの切り替え 方法A
 以後、切り替え後のプリンタで印刷されます

・プリンタの切り替え 方法B
 今回の印刷時のみ切り替え後のプリンタで印刷し、印刷終了後、元に戻します。

Excelシート画面

C〜E列はMyGetPrinterB()で登録されているプリンタを列挙しています。
C列はプリンタ名
C列は存在するフォルダ名
E列は通常使うプリンタならTRUE、そうでなければFALSEと表示されます

マーク位置が空白でない位置のプリンタで印刷します。
プリンタの変更

スポンサーリンク



Excel VBA実行コード

Option Explicit

Private Function MyGetPrinterB() As Long
    Dim lrow As Long
    Dim tobj As Object
    Dim tInstPrn As Variant
    Dim tprn As Object
    
    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, 3) = tprn.Name
        Cells(lrow, 4) = tprn.Location
        Cells(lrow, 5) = tprn.Default
        lrow = lrow + 1
    Next
    MyGetPrinterB = lrow
End Function

Private Sub MySetPrinterA(sPrn As String)
    ActiveSheet.PrintOut ActivePrinter:=sPrn
End Sub

Private Sub MySetPrinterB(sPrn As String)
    Dim sPush As String
    
    sPush = Application.ActivePrinter
    ActiveSheet.PrintOut ActivePrinter:=sPrn
    Application.ActivePrinter = sPush
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim lMaxRow As Long
    
    lMaxRow = MyGetPrinterB
    
    For i = 6 To lMaxRow
        If Cells(i, 2) <> "" Then
            MySetPrinterA Cells(i, 3)
            Exit For
        End If
    Next
    MyGetPrinterB
End Sub

Private Sub CommandButton2_Click()
    Dim i As Long
    Dim lMaxRow As Long
    
    lMaxRow = MyGetPrinterB
    
    For i = 6 To lMaxRow
        If Cells(i, 2) <> "" Then
            MySetPrinterB Cells(i, 3)
            Exit For
        End If
    Next
    MyGetPrinterB
End Sub

Excel Tipsメニューに戻る

スポンサーリンク






■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved