【ExcelVBA】複数のExcelファイルの全シートを一括印刷するマクロ

ねぇもりさん、毎週の定例会議で資料をたくさん印刷してるんだ。
エクセルが10ファイル・それぞれ5シート。全部まとめて印刷できる方法ないかなぁ？

もり

それなら、一括印刷できるマクロを作っちゃおう

複数のエクセルファイルの全シートを一括で印刷できるマクロを紹介します。

1つのExcelファイルの中に5シートあり、計10ファイルの場合、5シート×10ファイル＝50シートが一括で印刷できちゃいます！

Contents

指定ファイルの全シートを一括印刷するマクロ
- マクロの使い方
- 処理のポイント
（おまけ）各ファイル1シートのみを印刷したい場合

指定ファイルの全シートを一括印刷するマクロ

印刷対象のファイルとは別の「新しいExcelブック」を作成し、その標準モジュールに貼り付けて使用してください。

※用紙サイズ、縦横ｘページなどのレイアウト設定の処理はいれてません。

Sub 一括印刷()
    
   'ダイアログで印刷対象ブックを開く（複数ファイル指定可）
    Dim FileName As Variant
    FileName = Application.GetOpenFilename _
                    ("Microsoft Excelブック,*.xls?", MultiSelect:=True)
    
    If Not IsArray(FileName) Then
        Exit Sub
    End If

    Dim cnt As Long  '選択ファイル数のカウント
    cnt = UBound(FileName)

    Dim rc As Long '実行確認
    rc = MsgBox(cnt & "ファイルが選択されました。" & vbCrLf & _
    "印刷を開始しますか？", vbOKCancel + vbInformation)

    If rc = vbOK Then

        Dim n As Long '印刷対象のブック数
        For n = LBound(FileName) To UBound(FileName)
    
            Dim wb As Workbook '印刷対象ブック
            Set wb = Workbooks.Open(FileName(n))
        
                wb.Sheets.PrintOut '全シート印刷
    
            wb.Close False '保存しないで閉じる
    
        Next n
    
        MsgBox "印刷終了しました。"
    
    End If

End Sub

Sub 一括印刷()

'ダイアログで印刷対象ブックを開く（複数ファイル指定可）

Dim FileName As Variant

FileName = Application.GetOpenFilename _

("Microsoft Excelブック,*.xls?", MultiSelect:=True)

If Not IsArray(FileName) Then

Exit Sub

End If

Dim cnt As Long '選択ファイル数のカウント

cnt = UBound(FileName)

Dim rc As Long '実行確認

rc = MsgBox(cnt & "ファイルが選択されました。" & vbCrLf & _

"印刷を開始しますか？", vbOKCancel + vbInformation)

If rc = vbOK Then

Dim n As Long '印刷対象のブック数

For n = LBound(FileName) To UBound(FileName)

Dim wb As Workbook '印刷対象ブック

Set wb = Workbooks.Open(FileName(n))

wb.Sheets.PrintOut '全シート印刷

wb.Close False '保存しないで閉じる

Next n

MsgBox "印刷終了しました。"

End If

End Sub

マクロの使い方

マクロを実行すると「ファイルを開く」ダイアログが出現するので、印刷したいファイルを選択します。

ShiftキーまたはCtrlキーを使用して、印刷したいファイルをすべて選択
「開く」を押す

確認メッセージが登場するので、問題なければ「OK」を押します。

処理のポイント

ポイントは、配列インデックスの「最小値」と「最大値」を取得するLBoundとUBoundをFor文の条件にしていることです。

For n = LBound(FileName) To UBound(FileName)

    Dim wb As Workbook '印刷対象ブック
    Set wb = Workbooks.Open(FileName(n))

        wb.Sheets.PrintOut '全シート印刷

    wb.Close False '保存しないで閉じる

Next n