【Excel VBA】一覧表から個票PDFを一括作成

ExcelのVBAで、一覧表から個票PDFを一括作成する方法です。個票シートを一括作成する方法は、【Excel VBA】一覧表から個票シートを一括作成です。このVBAを修正し、VBAがあるExcelファイルと同じフォルダに、個票PDFを一括エクスポートするサンプルです。

使用のExcelは「Microsoft® Excel® for Microsoft 365 MSO」（バージョン2311）です。

内容：

アウトプットイメージ
基本のVBAサンプル
- VBAの前提
- リストから個票PDFを作成する基本サンプル
リストから個票PDFを作成するVBAサンプル（上書きの確認あり）
- 補足説明
参考：【Word VBA】差し込み印刷でレコード毎にPDFを保存するサンプル

アウトプットイメージ

VBAがあるExcelファイルと同じフォルダに、個票PDFを一括エクスポートする。

Excelファイルと同一フォルダに個別PDFに一括エクスポートしている — 一覧表から個票PDFを一括作成のアウトプットイメージ

この事例で、各シートの構成は次のとおり。

一括作成の設定は、シート「設定シート」
個票のレイアウトは、シート「日報」
一覧表は、シート「リスト」

個票のレイアウトは、【Excel】一覧表から個票のシート作成（VLOOKUP関数の利用）と同様にVLOOKUP関数で一覧表の値を参照している。

基本のVBAサンプル

VBAの前提

このVBAでは、個票のレイアウトがあるシート「日報」で、レコードを表す固有の値を順次変更、シートのコピーを繰り返す。

レコードを表す固有の値は、セルE1に入力されている
一覧表で一括作成する開始行と終了行の情報が、「設定シート」のセルD8、D9に入力されている

リストから個票PDFを作成する基本サンプル

この場合のシンプルなサンプルは次のとおり。

ただし、同じフォルダに既に同名のPDFが作成されている場合も上書きもされるので、注意が必要。

Option Explicit
    Dim 一覧シート As Worksheet
    Dim 個票様式 As Worksheet
    Dim 個票のレコードセル番地 As String
    Dim 開始行 As Long
    Dim 終了行 As Long
    Dim 行 As Long
    Dim 保存ファイル名 As String
    
Sub リストから個票PDFを作成する基本()
    Application.ScreenUpdating = False
    
    '初期設定'
        Set 一覧シート = ThisWorkbook.Sheets("リスト")
        Set 個票様式 = ThisWorkbook.Sheets("日報")
        個票のレコードセル番地 = "E1"
    
        開始行 = Sheets("設定シート").Range("D8").Value
        終了行 = Sheets("設定シート").Range("D9").Value
        
    For 行 = 開始行 To 終了行
        個票様式.Range(個票のレコードセル番地).Value = 一覧シート.Cells(行, 1).Value
        保存ファイル名 = ThisWorkbook.Path & "\" & 個票様式.Range(個票のレコードセル番地).Value & ".pdf"
                
        個票様式.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=保存ファイル名, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    Next 行

    Application.ScreenUpdating = True
End Sub

リストから個票PDFを作成するVBAサンプル（上書きの確認あり）

同じフォルダに既に同名のPDFが作成されている場合、上書きを確認するメッセージをつけたサンプルは次のとおり。

【Excel VBA】一覧表から個票シートを一括作成と同様、設定シートには、VBAのメンテナンス業務を減らすため、シート名等の情報を入力し、VBA実行時に参照している。

また、「設定シート」のセルD18に保存するフォルダ情報が入力されている。

Option Explicit
    Dim 一覧シート As Worksheet
    Dim 個票様式 As Worksheet
    Dim 個票のレコードセル番地 As String
    Dim 開始行 As Long
    Dim 終了行 As Long
    Dim 行 As Long
    Dim 保存ファイル名 As String
    Dim 現在パス As String
    Dim 上書確認 As VbMsgBoxResult
    
Sub リストから個票PDFの一括作成()
    Application.ScreenUpdating = False
    
    '初期設定　Sheets("設定シート")から値取得'
    With ThisWorkbook.Sheets("設定シート")
        Set 一覧シート = ThisWorkbook.Sheets(.Range("D3").Value)
        Set 個票様式 = ThisWorkbook.Sheets(.Range("D4").Value)
        個票のレコードセル番地 = .Range("D5").Value
    
        開始行 = .Range("D8").Value
        終了行 = .Range("D9").Value
        現在パス = .Range("D18").Value
    End With
    
    '終了行の確認、最大100件までとしている'
    If 終了行 - 開始行 > 100 Then
        終了行 = 開始行 + 100
        MsgBox "一括作成は、最大100件まで実行します"
    End If

    '繰り返し'
    For 行 = 開始行 To 終了行
        個票様式.Range(個票のレコードセル番地).Value = 一覧シート.Cells(行, 1).Value
        保存ファイル名 = 現在パス & "\" & 個票様式.Range(個票のレコードセル番地).Value & ".pdf"
        
        'ファイルの有無確認'
        If Dir(保存ファイル名) <> "" Then
            上書確認 = MsgBox("既にファイルがあります。上書きしますか？", vbYesNo + vbQuestion)
        Else
            上書確認 = vbYes 'ファイルがないので保存OKにする'
        End If
        
        If 上書確認 = vbYes Then
            個票様式.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=保存ファイル名, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        End If
    Next 行

    Application.ScreenUpdating = True
End Sub