VBA

【Excel VBA】フォルダ内のエクセルを一括印刷・PDF化

2019-10-18

Excelを一つ一つ印刷するのって面倒ですよね。エクスプローラー上で複数ファイル選択して右クリックから印刷等もできますが、もっとスマートに1ポチで全て印刷してみましょう。

手順としては以下のような感じです。

①ファイル一覧を作成する。
②ファイル一覧を上から順に読み込み印刷する。

 

ファイル一覧の作成

まず、ファイル一覧の作成ですが以下の記事で解説しております。サンプルプログラムもダウンロード可能です。是非ご利用ください。

https://reicode.info/recursive-file-list-with-vba/

 

ファイル一覧を上から順に読込み印刷

以下のような印刷用の標準モジュールを作成しました。

ボタンに登録すれば1ポチで一括印刷処理できますね♪

※ファイル一覧上の全Excelファイルの全シートを印刷設定に従って印刷します。印刷設定をマクロ上で設定する方法もありますが、ある程度フォーマットが統一されているドキュメント群でないと厳しいでしょう。基本は印刷設定済みのブックがこのマクロのターゲットです。

 

画面イメージはこのような感じです。

オプションの出力媒体で紙かPDFが選択できます。

 ※追加でハイパーリンクの「印刷する」から個別の印刷も可能にしました。

  その場合、オプションの印刷プレビューのOn/Offが選択できます。

 ※ファイル一覧上に印刷不要なファイルがある場合は、該当行を消せばOK

 

クリックすると別ウィンドウで拡大 表示する

標準モジュール:

 ※PrintExcelAll()が一括印刷ボタンに登録するマクロです。

標準モジュール:PrintExcel.bas
Option Explicit
Sub PrintExcel(ByVal OpenFile As Variant, ByVal PRAM_TYPE As Integer)
  Dim FSO      As New Scripting.FileSystemObject
  Dim myWB     As Workbook
  Dim SaveFile As String
  Dim rc       As Integer
  
  On Error GoTo Err_Exit
  
  If StrConv(LCase(OpenFile), vbNarrow) Like "*.xls*" Then
  Else
    If PRAM_TYPE = 1 Then
      MsgBox "Excelブックではありません。", vbCritical, "エラー"
    End If
  End If
  
  If PRAM_TYPE = 1 Then
    rc = MsgBox("全シートを印刷しますか? 出力媒体=" & RtnOutputMedia(), vbYesNo, "確認")
    If rc = vbYes Then
    Else
      Exit Sub
    End If
  End If
  
  With FSO
    If .FileExists(OpenFile) = True Then
      SaveFile = .GetParentFolderName(OpenFile) & "" & _
                 .GetBaseName(OpenFile) & ".pdf"
    Else
      Exit Sub
    End If
  End With
  
  On Error Resume Next
  Open OpenFile For Append As #1
  Close #1
  On Err GoTo Err_Exit
  
  If Err.Number <> 0 Then GoTo Err_Exit
  
  Set myWB = Workbooks.Open(FileName:=OpenFile, ReadOnly:=True, UpdateLinks:=0, _
               IgnoreReadOnlyRecommended:=True, Notify:=False, Password:="", Local:=True)
               
  If Err.Number <> 0 Then GoTo Err_Exit
  
  If PRAM_TYPE = 0 Then
    If RtnOutputMedia() = "紙" Then
      myWB.PrintOut Copies:=1, Collate:=True
    Else
      myWB.ExportAsFixedFormat Type:=xlTypePDF, FileName:=SaveFile
    End If
  Else
    If RtnOutputPreview() = True Then
      myWB.PrintOut Copies:=1, Collate:=True, Preview:=True
    End If
    
    rc = MsgBox("出力しますか? 出力媒体=" & RtnOutputMedia(), vbYesNo, "確認")
    If rc = vbYes Then
      If RtnOutputMedia() = "紙" Then
        myWB.PrintOut Copies:=1, Collate:=True
      Else
        myWB.ExportAsFixedFormat Type:=xlTypePDF, FileName:=SaveFile
      End If
    End If
  End If
  
Err_Exit:
  Set FSO = Nothing
  
  myWB.Close False
  Set myWB = Nothing
  
  If PRAM_TYPE = 0 Then Exit Sub
  
  If Err.Number <> 0 Then
    If Err.Number = 18 Then
      MsgBox "キャンセルしました。", vbCritical, "エラー"
    Else
      MsgBox "予期せぬエラー" & Err.Number, vbCritical, "エラー"
    End If
  Else
    MsgBox "処理完了しました。"
  End If
End Sub

Sub PrintExcelAll()
  Dim i  As Long
  Dim rc As Integer
  
  rc = MsgBox("一覧上のブックを一括で全シート印刷しますか?" & vbLf & _
              "※プレビューは無効になります。" & vbLf & _
              "出力媒体=" & RtnOutputMedia(), vbYesNo, "確認")
  If rc = vbYes Then
  Else
    Exit Sub
  End If
  
  On Error GoTo Err_Exit
  
  Application.StatusBar = "処理中です..."
  Application.ScreenUpdating = False
  Application.Cursor = xlWait
  Application.EnableCancelKey = xlErrorHandler
  
  With ThisWorkbook.ActiveSheet
    For i = 10 To .Cells(Rows.Count, 2).End(xlUp).Row
      Call PrintExcel(.Cells(i, 2) & "" & .Cells(i, 3), 0)
      If Err.Number <> 0 Then
        If Err.Number = 18 Then GoTo Err_Exit
        .Cells(i, 7).Value = "Err"
      Else
        .Cells(i, 7).Value = ""
      End If
    Next
    .Activate
    MsgBox "処理完了しました。"
  End With
  
Err_Exit:
  Application.StatusBar = False
  Application.ScreenUpdating = True
  Application.Cursor = xlDefault
  Application.EnableCancelKey = xlInterrupt
End Sub

Function RtnOutputMedia() As String
  With ThisWorkbook.ActiveSheet
    Select Case True
      Case .OptionButtons("Option_Paper").Value = xlOn
        RtnOutputMedia = "紙"
      Case .OptionButtons("Option_PDF").Value = xlOn
        RtnOutputMedia = "PDF"
      Case Else
        RtnOutputMedia = "PDF"
    End Select
  End With
End Function

Function RtnOutputPreview() As Boolean
  With ThisWorkbook.ActiveSheet
    Select Case True
      Case .OptionButtons("Option_PreviewOn").Value = xlOn
        RtnOutputPreview = True
      Case .OptionButtons("Option_PreviewOff").Value = xlOn
        RtnOutputPreview = False
      Case Else
        RtnOutputPreview = True
    End Select
  End With
End Function

 

参照設定

使用する場合は、以下の参照設定が必要です。使用しない場合は、CreateObjectで対応してください。

1)MicroSoft Scripting Runtime

2)Windows Script Host Object Model ※ファイル一覧作成時に使用

 

クリックすると別ウィンドウで拡大 表示する

 

検証環境

MicroSoft Office 2010 および 2016で検証しています。

ダウンロード

プログラムの配布は停止いたしました。(2021/2/6)

今までご利用ありがとうございました。

-VBA
-

© 2021 ReiCodeBlog