VBA課題003「領収書PDFを出力」回答コード

Excel・VBA総合コミュニティ「Excel-Fun.xls*」にて毎月出題される、
VBAの問題に対する私の回答ソースコードを掲載いたします。

今回掲載するコードは本ブログの基本問題集#1としても出題していた、
「領収書PDFを出力」問題です。

今回も読みやすさ重視で書いてみましたので、
よろしければご参考ください(´∀｀)

課題の内容

今回はデータシートから帳票をPDFに出力するシンプルなお題です。

詳細は下記リンク内にある「課題説明」シートをご確認ください。

せっかくなので回答を見る前に皆さんも挑戦してみましょう。

一度自分が作ってから他の人のコードを見ることで、
学習効果が何倍にも高まります。

完成させなくても、出来る範囲で解くだけでも十分効果がありますので、
是非ともトライしてみてください！

◇ 「領収書PDFを出力」の課題ファイルはこちら
Discord：★出題【VBA】#003 領収書PDFを出力

◇ 「領収書PDFを出力」への回答集はこちら
Discord：☆回答【VBA】#003 領収書PDFを出力

※上記はDiscord参加済みの方用のURLです
　未参加の方は下記からご参加ください！
www.limecode.jp

課題の回答ファイル

実際の回答ファイルはこちらをご覧ください。
(和風スパ)【VBA】003_領収書PDFを出力.xlsm

ソースコード

標準モジュール:Df_シートレイアウト

Option Explicit

' 販売データ
Public Const Adrs販売データ_年度 = "F2"
Public Const R1st販売データ = 5
Public Const C1st販売データ = 2
Public Enum CNo販売データ
    No = C1st販売データ
    購入者
    月
    日
    品物
    価格
    個数
    売上
    出力日
    一括出力
End Enum
Public Const CLast販売データ = CNo販売データ.一括出力

' 領収書
Public Const Adrs領収書_No = "D3"
Public Const Adrs領収書_購入日 = "F3"
Public Const Adrs領収書_購入者 = "C7"
Public Const Adrs領収書_売上 = "F9"
Public Const Adrs領収書_品物 = "F11"

' 販売データ
Function GetDate販売データ_購入日(R As Long)
    GetDate販売データ_購入日 = DateSerial年度版( _
        WS販売データ.Range(Adrs販売データ_年度), _
        WS販売データ.Cells(R, CNo販売データ.月), _
        WS販売データ.Cells(R, CNo販売データ.日))
End Function

標準モジュール:Pr0_領収書PDF_共通コード

Option Explicit

' 販売データ→領収書 PDF出力
Sub 販売データの指定行を領収書PDFに出力する(R_指定行 As Long)
    
    ' ■ 対象行のデータを転記
    Call 販売データの指定行を領収書シートに出力する(R_指定行)
    
    ' 出力フォルダのチェックと作成
    Dim path出力フォルダ As String: path出力フォルダ = ThisWorkbook.Path & "\領収書"
    If Dir(path出力フォルダ, vbDirectory) = "" Then MkDir path出力フォルダ
    
    ' ファイル名を設定
    Dim 出力ファイル名 As String
    出力ファイル名 = "領収書" & Format(WS領収書.Range(Adrs領収書_購入日), "yyyymmdd") _
                                             & "(" & WS領収書.Range(Adrs領収書_購入者) & ").pdf"
    ' PDFに出力
    WS領収書.ExportAsFixedFormat xlTypePDF, path出力フォルダ & "\" & 出力ファイル名

    ' 出力日の印字
    WS販売データ.Cells(R_指定行, CNo販売データ.出力日) = Format(Date, "m/d") & "済"

End Sub

' 販売データ→領収書 転記
Sub 販売データの指定行を領収書シートに出力する(R_指定行 As Long)
    
    WS領収書.Range(Adrs領収書_No) = WS販売データ.Cells(R_指定行, CNo販売データ.No)
    WS領収書.Range(Adrs領収書_購入者) = WS販売データ.Cells(R_指定行, CNo販売データ.購入者)
    WS領収書.Range(Adrs領収書_売上) = WS販売データ.Cells(R_指定行, CNo販売データ.売上)
    WS領収書.Range(Adrs領収書_品物) = WS販売データ.Cells(R_指定行, CNo販売データ.品物)
    WS領収書.Range(Adrs領収書_購入日) = GetDate販売データ_購入日(R_指定行)
    
End Sub

標準モジュール:Pr2_領収書PDF_一括実行

Option Explicit

' マクロ② 領収書を一括出力
Sub ★一括出力指定の全データを領収書PDFに出力する()
    
    ' 実行条件チェック
    If WorksheetFunction.CountIf(GetRange指定列のデータ部分(WS販売データ, CNo販売データ.一括出力), 1) = 0 Then
        MsgBox "一括出力列に「1」が立っている行がありません。"
        Exit Sub
    End If
    
    ' ■ 一括出力列の前回ログをクリア「完了」「失敗」
    Call 一括出力列の1以外の値をクリアする
    
    ' データシートの一括出力が「1」の行をループ
    Dim R As Long
    For R = R1st販売データ To Get最終行(WS販売データ, CNo販売データ.一括出力)
        If WS販売データ.Cells(R, CNo販売データ.一括出力) = 1 Then

            ' 出力日が空
            If WS販売データ.Cells(R, CNo販売データ.出力日) = "" Then
                
                ' ■ PDF出力の実行
                Call 販売データの指定行を領収書PDFに出力する(R)
                WS販売データ.Cells(R, CNo販売データ.一括出力) = "完了"
            
            ' 出力日あり
            Else
                WS販売データ.Cells(R, CNo販売データ.一括出力) = "失敗"
            End If
        
        End If
    Next ' データシートの一括出力が「1」の行をループ
    
    MsgBox "領収書PDFの一括出力を完了しました。"

End Sub

' 一括出力列の前回実行ログをクリア
Private Sub 一括出力列の1以外の値をクリアする()

    Dim R As Long
    For R = R1st販売データ To Get最終行(WS販売データ, CNo販売データ.一括出力)
        If WS販売データ.Cells(R, CNo販売データ.一括出力) <> 1 _
        And WS販売データ.Cells(R, CNo販売データ.一括出力) <> "" Then
            WS販売データ.Cells(R, CNo販売データ.一括出力) = ""
        End If
    Next

End Sub

' 一括出力列のクリア
Sub ★一括出力列をクリアする()
    GetRange指定列のデータ部分(WS販売データ, CNo販売データ.一括出力).Value = ""
End Sub

標準モジュール:Ut_汎用関数

Option Explicit

' 年度指定のDateSerial
Function DateSerial年度版(ByVal 年度 As Long, ByVal m As Long, ByVal d As Long) As Date
    If m <= 3 Then
        DateSerial年度版 = DateSerial(年度 + 1, m, d)
    Else
        DateSerial年度版 = DateSerial(年度, m, d)
    End If
End Function

' 最終行取得
Function Get最終行(対象シート As Worksheet, 対象列 As Long) As Long
    Get最終行 = 対象シート.Cells(対象シート.Rows.Count, 対象列).End(xlUp).Row
End Function

' データ件数
Function Countデータ件数(対象シート As Worksheet) As Long
    If 対象シート.AutoFilterMode = False Then Exit Function
    With 対象シート.AutoFilter.Range
        Countデータ件数 = .Rows.Count + .Row - 2
    End With
End Function

' 各列のデータ部分
Function GetRange指定列のデータ部分(対象シート As Worksheet, 対象列 As Long) As Range
    If Countフィルター行数(対象シート) = 0 Then Exit Function
    Set GetRange指定列のデータ部分 = 対象シート.Cells(対象シート.AutoFilter.Range.Row + 1, 対象列) _
                                                            .Resize(Countデータ件数(対象シート))
End Function

コードの解説

今回の課題は本ブログの基本問題集#1でも出題しており、
解答コードと解説ページも以下に公開しています。
VBA問題#1「領収書PDFを出力」解答(マクロ①)
VBA問題#1「領収書PDFを出力」解答(マクロ②)
VBA問題#1「領収書PDFを出力」解答(挑戦ポイント完成版)

各コードの細かい解説は上記の記事をご参考ください。

今回の課題はシンプルでしたので、
「問題集の解答として用意した上記リンクにあるコード」と、
「実際に自分が作った想定の本回答コード」で、ほとんど違いはありませんでした。

唯一変更したのが↓の「販売データの購入日取得をFunction化した」点です。

' 解答コード
WS領収書.Range(Adrs領収書_No) = WS販売データ.Cells(R_指定行, CNo販売データ.No)
WS領収書.Range(Adrs領収書_購入者) = WS販売データ.Cells(R_指定行, CNo販売データ.購入者)
WS領収書.Range(Adrs領収書_売上) = WS販売データ.Cells(R_指定行, CNo販売データ.売上)
WS領収書.Range(Adrs領収書_品物) = WS販売データ.Cells(R_指定行, CNo販売データ.品物)

WS領収書.Range(Adrs領収書_購入日) = DateSerial年度版( _
    WS販売データ.Range(Adrs販売データ_年度), _
    WS販売データ.Cells(R_指定行, CNo販売データ.月), _
    WS販売データ.Cells(R_指定行, CNo販売データ.日))

' 本ページのコード
WS領収書.Range(Adrs領収書_No) = WS販売データ.Cells(R_指定行, CNo販売データ.No)
WS領収書.Range(Adrs領収書_購入者) = WS販売データ.Cells(R_指定行, CNo販売データ.購入者)
WS領収書.Range(Adrs領収書_売上) = WS販売データ.Cells(R_指定行, CNo販売データ.売上)
WS領収書.Range(Adrs領収書_品物) = WS販売データ.Cells(R_指定行, CNo販売データ.品物)
WS領収書.Range(Adrs領収書_購入日) = GetDate販売データ_購入日(R_指定行)
     ' ↑ ここをFunction化

' シートレイアウトモジュールにFunctionを定義
Function GetDate販売データ_購入日(R As Long)
    GetDate販売データ_購入日 = DateSerial年度版( _
        WS販売データ.Range(Adrs販売データ_年度), _
        WS販売データ.Cells(R, CNo販売データ.月), _
        WS販売データ.Cells(R, CNo販売データ.日))
End Function

　
今回のマクロだけならそこまで必要ではないFunctionですが、
「販売データ」を元データに複数のマクロを作るとなると便利なFunctionです。

こういった「シート固有だけどすべてのマクロでは共通の計算」は、
定義モジュール内にFunctionで定義しておくとメンテナンスが楽になります。

こういった簡単なFunctionでも作っておくと後が楽ですので、
定義モジュールの使い方のひとつの方法として覚えておいてください。

その他の工夫ポイントとして、

• レイアウト変更への対応を考慮した設計
• Subプロシージャの分割＋処理ごとのモジュール分割
• 汎用関数の作成(年度版のDateSirial/指定列のデータ部分の取得)

あたりを意識してメンテナンス性を向上させました。

こちらの解説は以下の記事でじっくり行っていますので、
よろしければご参考ください。
www.limecode.jp