Excel VBA

【Excel VBA】PDFやExcelを一括で印刷する(サンプル有り)

本記事はこんな方におすすめです。

  • PDFの印刷の方法が知りたい
  • Excelの印刷の方法が知りたい
  • 印刷機能をツール化したい

サンプルツールの完成形

PDFの印刷方法

Excel VBAでPDFの印刷を行う場合、前準備が必要になります。

  • Adobe Reader のインストール
  • 参照設定の追加

前準備

Adobe Readerインストール

PDF操作をする為のAdobe製品をインストールします。こちらは無料で利用できるものです

https://www.adobe.com/jp/acrobat/pdf-reader.html

参照設定の追加

Adobe製品がインストールできたら、VBA画面で参照設定を追加します。

上部タブ内のツール(T)から「参照設定(R)」をクリックします。

ライブラリファイル内から「Windows Script Host Object Model」にチェックを入れて、「OK」ボタンをクリックします。

以上で前準備は完了です。

サンプルコード

それではPDFを印刷するサンプルコードがこちらになります。


Public Sub PDF_Print()

    'PDF印刷用変数
    Dim wshShellObj As IWshRuntimeLibrary.WshShell              'Shellオブジェクト
    Dim strShellCommand As String                               'Shellコマンド
    Dim printerName As String                                   'プリンタ名
  Dim filePath As String                                      'ファイルパス

    'オブジェクト定義/各取得
    Set wshShellObj = New IWshRuntimeLibrary.WshShell
    
    'プリンタ名取得
    printerName = Application.ActivePrinter

    'ファイルパス取得
  filePath = "C:\Users\sample.pdf"
        
    'Shellコマンドを実行(印刷処理)
    strShellCommand = "Acrobat.exe /t " & filePath & " " & printerName
    wshShellObj.Run (strShellCommand)

End Sub

Excelの印刷方法

Excelの印刷はもっと単純ですが、印刷対象が「今開いているブック」なのか、「別のブック」によって少しアクションが変わりますね。

2パターンの印刷方法を記したサンプルコードが以下になります。

サンプルコード

今開いているブックが対象

今開いているブックが対象の場合、PrintOutメソッドを以下のように使用します。

Public Sub Excel_Print()

    '1つ目のシートを印刷(1ページ)
  ThisWorkbook.Worksheets(1).PrintOut copies:=1

End Sub

別のブックが対象

別のブックが対象の場合、理屈は同じですが一度対象ブックを開いてからPrintOutメソッドで実行します。


Public Sub Excel_Print()

    '変数
    Dim wb As Workbook
    Dim filePath As String

    'ファイルパス取得
  filePath = "C:\Users\sample.xlsx"

    '対象ファイルを開く
    Set wb = Workbooks.Open(tmp.Path)
                    
    '対象ファイルを印刷する
    wb.Worksheets(1).PrintOut copies:=1
                    
    '対象ファイルを閉じる
    wb.Close

End Sub

サンプルツールの紹介

冒頭でお見せしたサンプルツールは、以下のような仕様で一括発行を実行します。

  • PDFの格納フォルダ、Excelの格納フォルダを設定シートで指定する。
  • 特定の条件でListView上に抽出したファイル名がフォルダ内にある複数のファイル内に存在するかどうか確認し、あれば印刷を実行する。
  • 印刷結果がデータシート上に出力される。

Private Sub cmd_Output_Click()

    '■0件チェック
    If lstv_Target.ListItems.Count <= 0 Then
        MsgBox "発行対象データが存在しません。", vbExclamation
        Exit Sub
    End If


    '■■■■■変数宣言
    Dim PdfPath As String
    Dim ExcelPath As String
        
    Dim ws As Worksheet
    Dim ws_setting As Worksheet
    
    Dim i, j As Long
    
    With ThisWorkbook
        Set ws = .Worksheets("データシート")
        Set ws_setting = .Worksheets("設定")
    End With


    '■■■■■フォルダパスの存在チェック
'    PdfPath = ws_setting.Range("B2").Text
    PdfPath = ThisWorkbook.Path & "\PDF"
'    ExcelPath = ws_setting.Range("B3").Text
    ExcelPath = ThisWorkbook.Path & "\Excel"
    
    If Dir(PdfPath, vbDirectory) = "" Then
        ''フォルダパスが存在しない
        MsgBox "PDFのフォルダパスが存在しません。" & vbCrLf & _
                "設定シートを確認して下さい。", vbExclamation
        Exit Sub
    End If
    If Dir(ExcelPath, vbDirectory) = "" Then
        ''フォルダパスが存在しない
        MsgBox "Excel表のフォルダパスが存在しません。" & vbCrLf & _
                "設定シートを確認して下さい。", vbExclamation
        Exit Sub
    End If
        
    
    '■■■■■フォルダ内ファイル取得処理
    Dim fso As Object
    Dim PdfFiles As Files
    Dim ExcelFiles As Files
    Dim tmp As Object
    
    '''PDF印刷用変数
    Dim wshShellObj As IWshRuntimeLibrary.WshShell              'Shellオブジェクト
    Dim strShellCommand As String                               'Shellコマンド
    Dim printerName As String                                   'プリンタ名
    
    '''Excel印刷用変数
    Dim wb As Workbook
    
    Dim ChildData As Variant
    Dim tgtNm As String
    Dim printFlg_pdf, printFlg_exl As Boolean
    
    Dim r As Long
    Dim lR As Long
        
    
    '■■■オブジェクト定義/各取得
    Set fso = New FileSystemObject
    Set wshShellObj = New IWshRuntimeLibrary.WshShell
    
    'PDFファイル取得
    Set PdfFiles = fso.GetFolder(PdfPath).Files
    
    'Excelファイル取得
    Set ExcelFiles = fso.GetFolder(ExcelPath).Files
    
    'プリンタ名取得
    printerName = GetPrinterInfo
    
    
    '■データシート初期化
    lR = ws.Range("B" & Rows.Count).End(xlUp).Row
    If lR < 4 Then
        lR = 4
    End If
    

    ws.Range("B4:G" & lR).Value = ""
    With ws.Range("B4:G" & lR).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
    
    
    '■■■対象PDF/Excelファイルの探索・印刷
    '確認ダイアログの非表示
    Application.DisplayAlerts = False
    r = 4
    For Each ChildData In lstv_Target.ListItems
        If ChildData.Checked Then
            tgtNm = ChildData.SubItems(1)
            
            '■対象履歴出力
            ws.Range("B" & r).Value = r - 3                 'No
            ws.Range("C" & r).Value = ChildData.SubItems(3) '処理日
            ws.Range("D" & r).Value = ChildData.SubItems(1) 'アイテムコード
            ws.Range("E" & r).Value = ChildData.SubItems(2) 'アイテム名称
            
            printFlg_pdf = False
            '■PDFファイル印刷
            For Each tmp In PdfFiles
                If InStr(tmp.Name, tgtNm) <> 0 Then
                    '■対象PDFに対する処理
                    
                    'エラー判別
                    On Error GoTo pdfErr
                    
                    'Shellコマンドを実行(印刷処理)
                    strShellCommand = "Acrobat.exe /t " & tmp.Path & " " & printerName
                    wshShellObj.Run (strShellCommand)
                    
                    printFlg_pdf = True
                    Exit For
pdfErr:
                    
                End If
            Next
            
            If printFlg_pdf Then
                ws.Range("F" & r).Value = "OK"
                With ws.Range("F" & r).Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent5
                    .TintAndShade = 0.7
                End With
            Else
                ws.Range("F" & r).Value = "NG"
                With ws.Range("F" & r).Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.7
                End With
            End If
            
            printFlg_exl = False
            '■Excelファイル印刷
            For Each tmp In ExcelFiles
                If InStr(tmp.Name, tgtNm) <> 0 Then
                    '■対象Excelに対する処理
                    
                    'エラー判別
                    On Error GoTo exlErr
                    
                    '対象ファイルを開く
                    Set wb = Workbooks.Open(tmp.Path)
                    Application.Windows(wb.Name).Visible = False
                    
                    '対象ファイルを印刷する
                    wb.Worksheets(1).PrintOut copies:=1
                    
                    '対象ファイルを閉じる
                    wb.Close
                    
                    printFlg_exl = True
                    Exit For
                    
exlErr:
                    
                End If
            Next
            

            ’「OK/NG」のセル背景色変更
            If printFlg_exl Then
                ws.Range("G" & r).Value = "OK"
                With ws.Range("G" & r).Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent5
                    .TintAndShade = 0.7
                End With
            Else
                ws.Range("G" & r).Value = "NG"
                With ws.Range("G" & r).Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.7
                End With
            End If
            
            r = r + 1
            
            If printFlg_pdf And printFlg_exl Then
                Call Upd_SyoriLevel(ChildData.SubItems(1))
            End If
            
        End If
    Next
    
    '■■■開いたPDFアプリケーション(Adobe Acrobat Reader)を閉じる
    Dim hWnd As Long
    Dim ret As Long
    Dim cnt As Long
    Do
        hWnd = FindWindow("AcrobatSDIWindow", vbNullString)
        DoEvents
        cnt = cnt + 1
        If cnt > 5000 Then
'            MsgBox "Adobe Acrobat Readerのクローズ処理に失敗しました。", vbCritical
            GoTo Finally
        End If
    Loop While hWnd = 0&
    Application.Wait Now + TimeSerial(0, 0, 5)
    ret = SendMessage(hWnd, WM_SYSCOMMAND, SC_CLOSE, 0)
    
    
Finally:
    '確認ダイアログの表示
    Application.DisplayAlerts = True
    
    '処理終了
    MsgBox "発行処理が完了しました。", vbInformation
    
    '■オブジェクトリソースの解放
    Set PdfFiles = Nothing
    Set ExcelFiles = Nothing
    Set fso = Nothing
    Set tmp = Nothing
    Set wshShellObj = Nothing
    
    Set wb = Nothing

End Sub

まとめ

Excel VBAでの印刷処理についてご紹介しました。

単純ですが、ケースによっては印刷オプションを設定したり、特定セルに値を出力してから印刷するなど、業務アプリケーションとしての要素は広く存在します。

ペーパーレスの時代に突入していますので、今後はどちらかと言うと今ある印刷処理部分がPDF出力処理に置き換わっていくのかなあと感じています。

いずれにしても、これくらいの処理は初心者の方でも簡単にできるので、カスタマイズに挑戦してみましょう!

よしこた
  • この記事を書いた人

よしこた

1992年生まれの牡羊座。
大学卒業後は地元の中小企業に就職し、
1年後にIT部門を立ち上げ、ITコンサルティング事業を始める。
クラウドソーシングをしつつ、ビギナー目線で記事を執筆します。

服やアニメが好き。仕事も割と好き。

-Excel VBA