【ExcelVBA】異なる書式で、複数のシートをPDF出力

スポンサーリンク
2025.03.05
この記事は約22分で読めます。

前回の記事では、印刷プレビューを設定していましたが、複数ある場合時間がかかりすぎるので、PDF出力するようにしてみました。

複数のシートをPDF出力する

前回の記事のコードを修正して、PDF出力するようにしてみました。

修正したコード

Sub PrintSheetsWithFukuokaShops_PDF_Only()
    Dim ws As Worksheet
    Dim dataSheet As Worksheet
    Dim fukuokaShops As Object
    Dim cell As Range
    Dim password As String
    Dim shopCode As Variant
    Dim printRange As Range
    Dim excludeSheets As Variant
    Dim i As Integer
    Dim tempPDFs As Object
    Dim finalPDFPath As String
    Dim tempPDFPath As String
    Dim sheetCount As Integer
    Dim processedCount As Integer

    ' ① 除外するワークシートをリスト化
    excludeSheets = Array("データ1", "データ2", "データ3")

    ' ② データシートの設定（店番コードと店名があるシート）
    Set dataSheet = ThisWorkbook.Sheets("データ")

    ' ③ 福岡の店番を格納する辞書（重複を避けるために使用）
    Set fukuokaShops = CreateObject("Scripting.Dictionary")

    ' シート保護解除用のパスワード
    password = "1234"

    ' ④ 画面更新を停止して処理速度を向上
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.StatusBar = "処理を開始しています..."

    ' ⑤ 一時PDFファイルのリストを作成
    Set tempPDFs = CreateObject("Scripting.Dictionary")

    ' ⑥ ドキュメントフォルダに最終的なPDFファイルを保存
    finalPDFPath = Environ("USERPROFILE") & "\Documents\福岡店番データ.pdf"

    ' ⑦ シート数をカウント
    sheetCount = ThisWorkbook.Sheets.Count
    processedCount = 0

    ' ⑧ データシートのC列を走査し、「福岡」の店番を辞書に格納
    For Each cell In dataSheet.Range("C1:C" & dataSheet.Cells(Rows.Count, 3).End(xlUp).Row)
        If cell.Value = "福岡" And Not fukuokaShops.exists(cell.Offset(0, -2).Value) Then
            fukuokaShops.Add cell.Offset(0, -2).Value, True
        End If
    Next cell

    ' ⑨ 各シートをループして、該当するシートのみPDF出力
    For Each ws In ThisWorkbook.Worksheets
        processedCount = processedCount + 1
        Application.StatusBar = "処理中: " & ws.Name & " (" & processedCount & "/" & sheetCount & ")"

        ' 除外リストに含まれるシートはスキップ
        For i = LBound(excludeSheets) To UBound(excludeSheets)
            If ws.Name = excludeSheets(i) Then GoTo NextSheet
        Next i

        ' ⑩ シート保護が有効なら解除
        If ws.ProtectContents Then
            On Error Resume Next
            ws.Unprotect Password:=password
            If Err.Number <> 0 Then
                MsgBox "シート '" & ws.Name & "' の保護を解除できませんでした。", vbCritical
                Exit Sub
            End If
            On Error GoTo 0
        End If

        ' ⑪ B2 または C4 に店番があるかチェック
        If Not IsEmpty(ws.Range("B2").Value) Then
            shopCode = ws.Range("B2").Value
            If fukuokaShops.exists(shopCode) Then
                ' A1:T60 を設定してPDF出力
                Set printRange = ws.Range("A1:T60")
                tempPDFPath = Environ("TEMP") & "\" & ws.Name & ".pdf"

                ' S列の幅を自動調整
                ws.Columns("S:S").AutoFit

                ' フォントサイズを変更（6行目～10行目のみ）
                With ws.Range("A6:T10").Font
                    .Size = 12
                    .Bold = True
                End With

                ' PDF出力
                Call ExportToPDF_AndStore(ws, printRange, tempPDFPath, tempPDFs, False)
            End If
        End If

        If Not IsEmpty(ws.Range("C4").Value) Then
            shopCode = ws.Range("C4").Value
            If fukuokaShops.exists(shopCode) Then
                ' A1:M46 を設定してPDF出力（フォントサイズ変更なし）
                Set printRange = ws.Range("A1:M46")
                tempPDFPath = Environ("TEMP") & "\" & ws.Name & ".pdf"

                ' PDF出力
                Call ExportToPDF_AndStore(ws, printRange, tempPDFPath, tempPDFs, False)
            End If
        End If

NextSheet:
    Next ws

    ' ⑫ すべての一時PDFを1つのPDFに結合
    If tempPDFs.Count > 0 Then
        MergePDFs tempPDFs, finalPDFPath
    End If

    ' ⑬ 画面更新を再開
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    ' ⑭ ステータスバーをリセット
    Application.StatusBar = False

' ⑮ 複数のPDFを1つに結合（Adobe Acrobat API が必要）
Sub MergePDFs(tempPDFs As Object, outputPDF As String)
    Dim AcroApp As Object, AcroAVDoc As Object, AcroPDDoc As Object
    Dim i As Integer

    ' Acrobat API の初期化
    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroPDDoc = CreateObject("AcroExch.PDDoc")

    ' 1つ目のPDFを開く
    If AcroPDDoc.Open(tempPDFs.items(0)) Then
        ' 他のPDFを追加
        For i = 1 To tempPDFs.Count - 1
            Dim TempPDDoc As Object
            Set TempPDDoc = CreateObject("AcroExch.PDDoc")
            If TempPDDoc.Open(tempPDFs.items(i)) Then
                AcroPDDoc.InsertPages AcroPDDoc.GetNumPages - 1, TempPDDoc, 0, TempPDDoc.GetNumPages, False
                TempPDDoc.Close
            End If
        Next i

        ' 保存
        AcroPDDoc.Save 1, outputPDF
        AcroPDDoc.Close
    End If

    ' Acrobat 終了
    AcroApp.Exit

    ' 一時PDFを削除
    For Each tempPDF In tempPDFs
        Kill tempPDF
    Next tempPDF
End Sub

    ' ⑯ 完了メッセージ
    MsgBox "福岡の店番があるシートと印刷シートのPDF出力が完了しました。" & vbCrLf & "保存場所：" & finalPDFPath, vbInformation
End Sub

' ⑰ PDF出力処理（B2とC4で異なる余白設定 & 一時保存）
Sub ExportToPDF_AndStore(ws As Worksheet, printRange As Range, tempPDFPath As String, tempPDFs As Object, isB2 As Boolean)
    ' 印刷範囲と書式を設定
    With ws.PageSetup
        .PrintArea = printRange.Address
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        
        ' 🔹 B2の店番シートの余白設定（狭め）
        If isB2 Then
            .LeftMargin = Application.InchesToPoints(0.3)
            .RightMargin = Application.InchesToPoints(0.3)
            .TopMargin = Application.InchesToPoints(0.6)
            .BottomMargin = Application.InchesToPoints(0.6)
        
        ' 🔹 C4の店番シートの余白設定（広め）
        Else
            .LeftMargin = Application.InchesToPoints(0.6)
            .RightMargin = Application.InchesToPoints(0.6)
            .TopMargin = Application.InchesToPoints(0.9)
            .BottomMargin = Application.InchesToPoints(0.9)
        End If
        
        .CenterHorizontally = True
        .CenterVertically = True
    End With

    ' PDFとしてエクスポート
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempPDFPath, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

    ' PDFリストに追加
    tempPDFs.Add tempPDFPath, tempPDFPath
End Sub

📢 まとめ

✅ 「B2」店番シート → 6行目～10行目のフォントサイズを変更 + S列を自動調整

✅ すべてのPDFを1つにまとめて「ドキュメント」フォルダに保存

✅ 処理を高速化 & 画面更新を停止 (Application.ScreenUpdating = False)

✅ ポップアップで現在の処理状況を表示

 

変数の詳細

変数名 データ型 処理概要（用途）
ws Worksheet 現在処理中のワークシート を格納する変数
dataSheet Worksheet 店番と店名が記録されているデータシート を格納
fukuokaShops Object 福岡の店番コードを格納する辞書（Dictionary）
cell Range データシートの各セルを処理するための変数
password String シート保護解除用のパスワード を格納
shopCode Variant B2またはC4の店番コードを一時的に格納
printRange Range 印刷対象の範囲（A1:T60など）を格納
excludeSheets Variant 除外するシート名のリスト（配列）を格納
i Integer ループカウンター（除外リストのチェック用）
tempPDFs Object 一時PDFファイルのリスト（Dictionary）を格納
finalPDFPath String 最終的に保存するPDFファイルのパス（ドキュメントフォルダ）
tempPDFPath String 各ワークシートごとの一時PDFファイルのパス

📌 Dim で宣言された変数の詳細な用途

  1. ws（現在処理中のシート）

    • For Each ws In ThisWorkbook.Worksheets のループで 1シートずつ処理 するときに使用。

  2. dataSheet（データシート）

    • Set dataSheet = ThisWorkbook.Sheets("データ")
    • 福岡の店番コードを取得する元データのシートを格納。

  3. fukuokaShops（福岡の店番コードを記録する辞書）

    • Set fukuokaShops = CreateObject("Scripting.Dictionary")
    • fukuokaShops.Add shopCode, True
    • 辞書（Dictionary）を使い、福岡の店番コードを一意に記録する。

  4. cell（データシートの各セルを処理）

    • For Each cell In dataSheet.Range("C1:C" & dataSheet.Cells(Rows.Count, 3).End(xlUp).Row)
    • データシートのC列（店名が入っている列）を1つずつ処理。

  5. password（シートの保護解除用パスワード）

    • password = "1234"
    • ws.Unprotect Password:=password
    • シート保護がかかっている場合に解除するためのパスワードを格納。

  6. shopCode（現在のシートの店番コード）

    • shopCode = ws.Range("B2").Value
    • B2（またはC4）から取得した店番コードを一時的に格納 し、福岡の店番リストに含まれるか判定する。

  7. printRange（印刷範囲の設定）

    • Set printRange = ws.Range("A1:T60")
    • 現在処理中のシートの印刷範囲を記録。

  8. excludeSheets（除外するシートリスト）

    • excludeSheets = Array("データ1", "データ2", "データ3")
    • 印刷対象から除外するシートのリストを配列で保持。

  9. i（ループカウンター）

    • For i = LBound(excludeSheets) To UBound(excludeSheets)
    • 除外シートリストを1つずつチェックするためのループ変数。

  10. tempPDFs（一時PDFファイルのリスト）

    • Set tempPDFs = CreateObject("Scripting.Dictionary")
    • 一時的にPDFを保存するためのリスト を管理し、最後に 1つのPDFに統合する。

  11. finalPDFPath（最終的なPDFファイルの保存場所）

    • finalPDFPath = Environ("USERPROFILE") & "\Documents\福岡店番データ.pdf"
    • すべてのPDFを1つに統合した後、ドキュメントフォルダに保存するパスを格納。

  12. tempPDFPath（一時PDFファイルのパス）

    • tempPDFPath = Environ("TEMP") & "\" & ws.Name & ".pdf"
    • 各シートごとに作成される一時的なPDFファイルの保存パスを記録。

📢 変数のまとめ

✅ Dim ws As Worksheet → 現在のシートを処理するための変数
✅ Dim fukuokaShops As Object → 福岡の店番コードを記録する辞書（Dictionary）
✅ Dim excludeSheets As Variant → 印刷対象から除外するシートのリスト
✅ Dim tempPDFs As Object → すべてのPDFを1つに統合するためのリスト
✅ Dim finalPDFPath As String → 最終的なPDFの保存先（ドキュメントフォルダ）

 

シート名を指定してPDF出力するマクロ

Sub PrintSpecialRange_PDF()
    Dim ws As Worksheet
    Dim printRange As Range
    Dim tempPDFPath As String

    ' ① 「印刷」シートを設定
    Set ws = ThisWorkbook.Sheets("印刷")

    ' ② 印刷範囲（AJ5:AO10）を設定
    Set printRange = ws.Range("AJ5:AO10")
    tempPDFPath = Environ("USERPROFILE") & "\Documents\印刷シート.pdf"

    ' ③ フォントサイズを変更
    With printRange.Font
        .Name = "Arial"
        .Size = 12
        .Bold = True
    End With

    ' ④ 書式設定
    With ws.PageSetup
        .PrintArea = printRange.Address
        .Orientation = xlPortrait  ' A4縦
        .PaperSize = xlPaperA4
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.4)  ' 上寄せ（余白を狭める）
        .BottomMargin = Application.InchesToPoints(0.9)
        .CenterHorizontally = True
        .CenterVertically = False  ' 上寄せのため、縦方向の中央揃えをオフ
    End With

    ' ⑤ PDFとしてエクスポート
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempPDFPath, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

    ' ⑥ 完了メッセージ
    MsgBox "「印刷」シートのPDF出力が完了しました。" & vbCrLf & "保存場所：" & tempPDFPath, vbInformation
End Sub

Adobe Acrobat 無償版（Reader）しかない場合の対応策

Adobe Acrobat 有償版がない場合 は、VBAでは AcroExch.PDDoc を使用できません。そのため、別の方法でPDFを結合する 必要があります。

✅ 方法①: 無償の「PDFtk」を使用してVBAでPDFを結合する
✅ 方法②: Windows のコマンド (copy /b) を利用して単純結合する（制限あり）
✅ 方法③: 手動でPDFを結合（VBA外の対応）

✅ 方法① PDFtk を使ってPDFを結合（推奨）

📌 必要な準備

  1. 無償のPDFツール「PDFtk Free」をインストール

  2. VBAからPDFtkを呼び出してPDFを結合

VBAコード（PDFtk を使ったPDF結合）

Sub MergePDFs_PDFtk(tempPDFs As Object, outputPDF As String)
    Dim pdfList As String
    Dim tempPDF As Variant
    Dim command As String

    ' ① PDFのリストを作成
    pdfList = ""
    For Each tempPDF In tempPDFs
        pdfList = pdfList & " """ & tempPDF & """"
    Next tempPDF

    ' ② PDFtk のコマンドを作成
    command = "C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & pdfList & " cat output """ & outputPDF & """"

    ' ③ コマンドを実行
    Shell command, vbNormalFocus

    ' ④ 一時ファイルを削除
    For Each tempPDF In tempPDFs
        Kill tempPDF
    Next tempPDF
End Sub

📌 使い方

  1. MergePDFs tempPDFs, finalPDFPath を MergePDFs_PDFtk tempPDFs, finalPDFPath に変更
  2. PDFtk をインストールして C:\Program Files (x86)\PDFtk\bin\pdftk.exe にあることを確認
  3. VBAを実行

✅ 方法② Windows コマンド (copy /b) を使う

📌 注意点

  • 単純な「バイナリ結合」 であり、PDFとしての整合性が取れない場合がある。
  • AcrobatやPDFリーダーで開けない可能性がある（推奨されない）。
  • PDFのページ情報が壊れることがある。
Sub MergePDFs_Copy(tempPDFs As Object, outputPDF As String)
    Dim pdfList As String
    Dim tempPDF As Variant
    Dim command As String

    ' ① PDFのリストを作成
    pdfList = ""
    For Each tempPDF In tempPDFs
        pdfList = pdfList & " """ & tempPDF & """"
    Next tempPDF

    ' ② Windows コマンドを作成
    command = "cmd /c copy /b " & pdfList & " """ & outputPDF & """"

    ' ③ コマンドを実行
    Shell command, vbNormalFocus

    ' ④ 一時ファイルを削除
    For Each tempPDF In tempPDFs
        Kill tempPDF
    Next tempPDF
End Sub
スポンサーリンク

コメント

タイトルとURLをコピーしました