VBA問題#1「領収書PDFを出力」完成版解答

ExcelVBA練習問題シリーズ#1「領収書PDFを出力」の、
マクロ①②＋挑戦ポイントにすべて対応した完全解答版です。

もちろんこれが正解という訳ではなく、いろいろなやり方あると思いますが、
ひとつの解答としてご参考ください。

◇ 出題ページはこちら
www.limecode.jp
◇ 解答ページはこちら
VBA問題#1「領収書PDFを出力」マクロ①解答
VBA問題#1「領収書PDFを出力」マクロ②解答
VBA問題#1「領収書PDFを出力」解答完成版(挑戦ポイント制覇)【本ページ】
　

解答ファイル

【VBA解答】#1「領収書を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"

標準モジュール: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領収書_購入日) = DateSerial年度版( _
        WS販売データ.Range(Adrs販売データ_年度), _
        WS販売データ.Cells(R_指定行, CNo販売データ.月), _
        WS販売データ.Cells(R_指定行, CNo販売データ.日))
        
End Sub

標準モジュール:Pr1_領収書PDF_単独実行

Option Explicit

' マクロ① 選択行から領収書を出力
Sub ★選択行のデータを領収書PDFに出力する()

    ' 実行条件チェック
    If Selection.Rows.Count >= 2 Then MsgBox "1行だけを選択して実行して下さい。": Exit Sub
    
    Dim R_選択行 As Long: R_選択行 = Selection.Row
    If R_選択行 < R1st販売データ Then MsgBox "データエリアを選択して実行してください。": Exit Sub
    
    If WS販売データ.Cells(R_選択行, CNo販売データ.売上) = 0 Then MsgBox "その行にデータがありません。": Exit Sub
    
    If WS販売データ.Cells(R_選択行, CNo販売データ.出力日) <> "" Then MsgBox "この行は既に出力済です。": Exit Sub

    ' ■ 実行
    Call 販売データの指定行を領収書PDFに出力する(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

解説

処理の基本部分についての解説は、
マクロ①②の解答で詳しく行っていますのでそちらをご参考ください。
VBA問題#1「領収書PDFを出力」解答(マクロ①)
VBA問題#1「領収書PDFを出力」解答(マクロ②)

本記事では「挑戦ポイント」への対応内容を解説していきます。

コードを読む際は、上記マクロ①②の解答ファイルと見比べることで、
コードをどのように改良したかがより分かりやすくなると思います。

よろしければ横に並べてご覧ください。

レイアウト変更への対応を考慮した設計

【挑戦ポイント】
販売データの列の変更や、領収書のレイアウトの変更に対応できるよう設計してみてください。

こちらの課題、いわゆる「メンテナンス性の向上」については、
シートレイアウトをEnum・定数で定義しひとつのモジュールにまとめました。

軽微な変更(行列の挿入削除程度)であれば、
「Df_シートレイアウト」モジュールを変更するだけでマクロを改修できます。

簡単に解説しますと、Enum・定数を使用したことで、

WS領収書.Range("F9") = WS販売データ.Cells(R, 9)

' ⇩ Enumと定数を使って書き替え

WS領収書.Range(Adrs領収書_売上) = WS販売データ.Cells(R_指定行, CNo販売データ.売上)

こんな風にコードが書き換わっています。

まずはコードが読めるようになっているというのが大きな利点ですが、
さらに強力なメリットとして、列の追加削除対応を瞬殺できるようになります。

例えば「購入者」列の右に「住所」列を追加するとしましょう。

Enumなしの場合は、Cells中身の「9」を「10」に書き換える作業を、
すべてコードから探して行う必要があります。

この大変さを味わったことがある人は多いはず。

しかしEnumを用いている場合は、
Enumの設定箇所を↓のように書き換えるだけで改修が完了してしまいます。

Public Const C1st販売データ = 2
Public Enum CNo販売データ
    No = C1st販売データ ' ここが2
    購入者   ' 以下Enumの自動連番機能で3,4,…と進む
    住所      ' ← これをEnumに追加。4となる
    月         ' ← ここから下は5,6,…と自動で+1されるので以下対応は不要！
    日
    品物
    価格
    個数
    売上      ' ← 9が10にしっかり変わっている！
    出力日
    一括出力
End Enum

素晴らしい機能ですよね！

列番号をいちいち打ち換える地獄のような作業が、
列名をひとつ書くだけで済むようになっています。

メンテナンス性を考えた時、これほど簡単で強力な機能はなかなかありませんので、
まだ使っていなかった方は是非一度使ってみて下さい。

Enumについては詳しく書いた記事がありますので、
興味がる方は是非ご覧下さい。
www.limecode.jp

またEnumの勉強会のYoutube配信アーカイブもありますので、
こちらもあわせてご活用いただければと思います。

Subプロシージャの分割

【挑戦ポイント】
マクロ1とマクロ2で同じコードを使えるように「Subプロシージャ」を分割してみてください。

こちらは「販売データ1行⇒領収書」のメイン処理部をプロシージャにしました。

このようにコア部分をプロシージャ化することで、

マクロ①が↓のように簡潔なコードで書け、

Sub ★選択行のデータを領収書PDFに出力する()

    ' 実行条件チェック
    If Selection.Rows.Count >= 2 Then MsgBox "1行だけを選択して実行して下さい。": Exit Sub
    
    Dim R_選択行 As Long: R_選択行 = Selection.Row
    If R_選択行 < R1st販売データ Then MsgBox "データエリアを選択して実行してください。": Exit Sub
    
    If WS販売データ.Cells(R_選択行, CNo販売データ.売上) = 0 Then MsgBox "その行にデータがありません。": Exit Sub
    
    If WS販売データ.Cells(R_選択行, CNo販売データ.出力日) <> "" Then MsgBox "この行は既に出力済です。": Exit Sub

    ' ■ 実行
    Call 販売データの指定行を領収書PDFに出力する(R_選択行)

End Sub

　
マクロ②も↓のようにループ全体が見渡しやすいコードになっています。

' データシートの一括出力が「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」の行をループ

　
どちらも簡潔になっているのがわかりますし、
両者が同じコード1つで動いているのもプロシージャ分割の良さですね。

ちなみにこのメインコードは「データ1行 ⇒ PDFファイル」を行っていますが、
さらに細かく「データ1行⇒領収書シートへの転記」部分も分割しています。

こうすることで、今後「PDFではなく別ブックに出力」などの機能追加が出ても、
このプロシージャをCallすれば実装できるというのが狙いです。

あとは全体的な話ですが、分割したプロシージャを、

こんな風に処理ごとにモジュール分割しているのも地味ですが重要なポイントです。

モジュールは名称によって自動で並び変わってしまいますので、
頭文字＋数字を付けて並びをコントロールしましょう。

汎用関数の作成(年度版のDateSirial ほか)

【挑戦ポイント】
DateSirial年度版(年度, m, d) を「Functionプロシージャ」で作成してみてください。

こちらはまずその関数を作成しました。

' 年度指定の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

　
こんな単純な関数でも、メインコードをこれだけスッキリかけるようになります。

' 販売データ→領収書 転記
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領収書_購入日) = DateSerial年度版( _
        WS販売データ.Range(Adrs販売データ_年度), _
        WS販売データ.Cells(R_指定行, CNo販売データ.月), _
        WS販売データ.Cells(R_指定行, CNo販売データ.日))
            ' ↑ この部分が相当書きやすく＆読みやすくなっている。

End Sub

　
Functionと聞くと最初は難しそうに感じるかもしれませんが、
こういった単純な処理を切り出すだけなら案外簡単に作ることができます。

それでいて効果は抜群ですから、マクロづくりに慣れてきたら、
自作の汎用関数(ライブラリ)作りにぜひ挑戦してみましょう。

今回は汎用関数の例として、年度指定のDateSerialのほかに、
「Get最終行」「GetRange指定列のデータ部分」も作成してみました。

「Get最終行」はおなじみのEndプロパティによる最終行取得ですが、
頻出なだけに、これも関数にしておくとサクサクコードが書けるようになります。

「GetRange指定列のデータ部分」は、

この部分をRangeオブジェクトとして取得する関数です。

ここを取得したい場面はかなり多いのですが、
単純な割には結構コード量が多くなってしまう場所ですからね。

ここを関数化しておくことで、
↓のようにコードを相当スッキリさせることができます。

' 一括出力列のクリア　のコード比較

Sub 一括出力列をクリアする()

    Dim LastR販売データ As Long
    LastR販売データ = WS販売データ.AutoFilter.Range.Rows.Count + WS販売データ.AutoFilter.Range.Row - 1
    
    WS販売データ.Range(WS販売データ.Cells(5, 11) _
                              , WS販売データ.Cells(LastR販売データ, 11)).Value = ""

End Sub

' ⇩ 汎用関数を利用した書き替え

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

書き替え後のコードの単純明快さを見ると、
この関数の強力さが伝わると思います。

このようによく書くコードを汎用関数にしておくと、
メインコードを劇的に書きやすく＆読みやすくすることができます。

単純な処理をFunctionにするだけなら思ったよりも簡単ですので、
是非とも挑戦してみてください。

詳しくはこちらの記事をどうぞ。
www.limecode.jp

以上で挑戦ポイントを網羅した完成版の解説を終わります。

マクロ①②の解答コードと見比べると、
全く同じ処理でも全然違う書き方になっているのがわかります。

ある程度処理が書けるようになったら、
メンテナンス性や可読性を意識したコードに挑戦してみましょう。

マクロの改修が楽になったり、バグの発生率を落とすことができます。

コードの書き方にはいろいろな方法がありますので、
いろいろなコードを眺めて参考にしてみてください。