VBA100本ノック 83本目：請求書を作成してPDF出力

公開日：2021-02-08　最終更新日：2021-02-22

VBA100本ノック 83本目：請求書を作成してPDF出力

売上シートにある全取引先のPDF請求書を作成する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 83本目
「売上」シートにある全取引先のPDF請求書を作成してください。
Thisworkbookパスの下に「請求書」フォルダを作成し、ファイル名「取引先名_yyyymm.pdf」で出力。yyyymmは実行日。
※商品行は10行を超えません。
※取引先名はファイルに使えない文字は使っていません。

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_83.xlsm
https://excel-ubara.com/vba100sample/VBA100_83.zip

元のシートに名前定義等の設定をするのは随意。
正しく請求書を作成し、PDF出力出来れば構いません。

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

この問題は書きやすい方法で書けば良いと思います。
100本ノックをここまで進んできた人なら色々な書き方ができると思ったはずです。
私が書いたものは愚直にセルを転記していくものです。
考慮したのはマスタが無い場合も出力するようにしたくらいですが、必要性は微妙です。


  
    
      Sub VBA100_83_01()

　　Dim ws売上 As Worksheet: Set ws売上 = Worksheets("売上")

　　Dim wsマスタ As Worksheet: Set wsマスタ = Worksheets("取引先マスタ")

　　Dim ws請求書 As Worksheet: Set ws請求書 = Worksheets("請求書")

　　

　　Dim sPath As String

　　sPath = ws売上.Parent.Path & "\請求書"

　　If Dir(sPath, vbDirectory) = "" Then MkDir sPath

　　

　　Dim oldCd As String, oldName As String

　　Dim i As Long, j As Long, outRow As Long

　　

　　For i = 2 To ws売上.Cells(ws売上.Rows.Count, 1).End(xlUp).Row

　　　　If ws売上.Cells(i, 1) <> oldCd Then

　　　　　　Call PDF出力(ws請求書, wsマスタ, oldCd, oldName, sPath)

　　　　　　

　　　　　　oldCd = ws売上.Cells(i, 1)

　　　　　　oldName = ws売上.Cells(i, 2)

　　　　　　outRow = 10

　　　　End If

　　　　

　　　　ws請求書.Cells(outRow, 1) = ws売上.Cells(i, 3)

　　　　ws請求書.Cells(outRow, 3) = ws売上.Cells(i, 4)

　　　　ws請求書.Cells(outRow, 4) = ws売上.Cells(i, 5)

　　　　outRow = outRow + 1

　　Next

　　Call PDF出力(ws請求書, wsマスタ, oldCd, oldName, sPath)

　　

　　MsgBox "請求書作成完了"

End Sub


Sub PDF出力(ByVal ws請求書 As Worksheet, ByVal wsマスタ As Worksheet, _

　　　　　　ByVal aCode As String, ByVal aName As String, ByVal aPath As String)

　　Const clearAddress = "A2:A5,A10:D24"

　　If aCode = "" Then

　　　　ws請求書.Range(clearAddress).ClearContents

　　　　Exit Sub

　　End If

　　

　　Dim i As Long

　　On Error Resume Next

　　i = WorksheetFunction.Match(aCode, wsマスタ.Columns(1), 0)

　　On Error GoTo 0

　　

　　If i = 0 Then

　　　　ws請求書.Cells(2, 1) = aName

　　Else

　　　　ws請求書.Cells(2, 1) = wsマスタ.Cells(i, 2)

　　　　ws請求書.Cells(3, 1) = "〒" & wsマスタ.Cells(i, 3)

　　　　ws請求書.Cells(4, 1) = wsマスタ.Cells(i, 4)

　　　　ws請求書.Cells(5, 1) = wsマスタ.Cells(i, 5)

　　End If

　　

　　ws請求書.ExportAsFixedFormat Type:=xlTypePDF, _

　　　　Filename:=aPath & "\" & ws請求書.Cells(2, 1) & Format(Date, "_yyyymm") & ".pdf"

　　

　　ws請求書.Range(clearAddress).ClearContents

End Sub

件数と速度を考慮しつつ、レイアウト変更への対応しやすさ等を考えてVBAを作成すれば良いと思います。
TypeやEnumを使った例を100本ノックでは出していなかったので、これらを使って書き直したVBAを記事補足に掲載しました。

補足

マスタなしを考慮すべきかどうかは、元データの出所次第でしょう。
他システムからインポートした場合なら食い違いもありえるので、その場合のチェックなどは別途考えないといけないと思います。

VBA100本ノックの出題はVBAの書き方を制約する出題にしていないので、Type（ユーザー定義型）やEnum（列挙型）を使う機会が少なくなってしまっています。
ツイッターでの出題と回答という形式なので、どうしても短いVBAを選択してしまうというのもあると思います。
TypeやEnumを記述すると、どうしてもVBA行数は多くなってしまうので仕方ないところかもしれません。

以下では、先のVBAと似たような処理方法を、
Type
Enum
Dictionary
配列
これらを使って書き直したものになります。
サンプルVBAとして、少々無理やり使っているというところもありますが、少しでも参考になれば幸いです。


  
    
      Option Explicit


Type t売上

　　取引先CD As Variant

　　取引先名 As Variant

　　商品名 As Variant

　　数量 As Variant

　　税抜単価 As Variant

End Type


Enum col売上

　　取引先CD = 1

　　取引先名

　　商品名

　　数量

　　税抜単価

　　税抜金額

End Enum


Enum col取引先

　　取引先CD = 1

　　取引先名

　　郵便番号

　　住所1

　　住所2

End Enum


Const cns請求先 As String = "A2:A5"

Const cns請求明細 As String = "A10:D24"


Enum row請求先

　　取引先名 = 1

　　郵便番号

　　住所1

　　住所2

End Enum


Enum col請求明細

　　品名 = 1

　　数量 = 3

　　単価 = 4

End Enum


Sub VBA100_83_02()

　　Dim fso As New Scripting.FileSystemObject

　　Dim sPath As String: sPath = ThisWorkbook.Path & "\請求書"

　　If Not fso.FolderExists(sPath) Then fso.CreateFolder sPath

　　

　　Dim ary売上() As t売上:　　　　 ary売上 = get売上(Worksheets("売上"))

　　Dim dic取引先 As Dictionary:　　Set dic取引先 = get取引先(Worksheets("取引先マスタ"))

　　Dim ws請求書 As Worksheet:　　　Set ws請求書 = Worksheets("請求書")

　　Call clear請求書(ws請求書)

　　

　　ReDim Preserve ary売上(LBound(ary売上) To UBound(ary売上) + 1) '次と比較するのでUBoundを+1

　　Dim i As Long, j As Long, aryTmp

　　For i = LBound(ary売上) + 1 To UBound(ary売上) - 1

　　　　j = j + 1

　　　　ws請求書.Range(cns請求明細).Cells(j, col請求明細.品名) = ary売上(i).商品名

　　　　ws請求書.Range(cns請求明細).Cells(j, col請求明細.数量) = ary売上(i).数量

　　　　ws請求書.Range(cns請求明細).Cells(j, col請求明細.単価) = ary売上(i).税抜単価

　　　　

　　　　If ary売上(i).取引先CD <> ary売上(i + 1).取引先CD Then

　　　　　　If dic取引先.Exists(ary売上(i).取引先CD) Then

　　　　　　　　aryTmp = dic取引先(ary売上(i).取引先CD)

　　　　　　　　ws請求書.Range(cns請求先).Cells(row請求先.取引先名).Value = aryTmp(1, col取引先.取引先名)

　　　　　　　　ws請求書.Range(cns請求先).Cells(row請求先.郵便番号).Value = "〒" & aryTmp(1, col取引先.郵便番号)

　　　　　　　　ws請求書.Range(cns請求先).Cells(row請求先.住所1).Value = aryTmp(1, col取引先.住所1)

　　　　　　　　ws請求書.Range(cns請求先).Cells(row請求先.住所2).Value = aryTmp(1, col取引先.住所2)

　　　　　　Else

　　　　　　　　ws請求書.Range(cns請求先).Cells(1).Value = ary売上(i).取引先名

      　　　　　　End If


　　　　　　ws請求書.ExportAsFixedFormat Type:=xlTypePDF, _

      　　　　　　　　Filename:=sPath & "\" & ws請求書.Range(cns請求先).Cells(1).Value & Format(Date, "_yyyymm") & ".pdf"


　　　　　　Call clear請求書(ws請求書)

　　　　　　j = 0

　　　　End If

　　Next

　　

      　　Set fso = Nothing

      　　MsgBox "請求書作成完了"

End Sub


Sub clear請求書(ByVal ws請求書 As Worksheet)

　　ws請求書.Range(cns請求先).ClearContents

　　ws請求書.Range(cns請求明細).ClearContents

End Sub


Function get売上(ByVal ws As Worksheet) As t売上()

　　Dim ary売上() As t売上

　　Dim cnt As Long, i As Long, rng As Range

　　cnt = ws.Range("A1").CurrentRegion.Rows.Count

　　ReDim ary売上(1 To cnt)

　　For i = 1 To cnt

　　　　ary売上(i).取引先CD = ws.Cells(i, col売上.取引先CD).Value

　　　　ary売上(i).取引先名 = ws.Cells(i, col売上.取引先名).Value

　　　　ary売上(i).商品名 = ws.Cells(i, col売上.商品名).Value

　　　　ary売上(i).数量 = ws.Cells(i, col売上.数量).Value

　　　　ary売上(i).税抜単価 = ws.Cells(i, col売上.税抜単価).Value

　　Next

　　get売上 = ary売上

End Function


Function get取引先(ByVal ws As Worksheet) As Scripting.Dictionary

　　Dim dic取引先 As New Scripting.Dictionary

　　Dim rng As Range, v

　　For Each rng In ws.Range("A1").CurrentRegion.Rows

      　　　　dic取引先(rng.Cells(col取引先.取引先CD).Value) = rng.Value

　　Next

　　Set get取引先 = dic取引先

      End Function

サイト内関連ページ

第139回．エクスポート（PDF/XPS）

・PDFとは、XPSとは・ExportAsFixedFormatメソッド・PDFのオプションについて・ExportAsFixedFormatの使用例

第109回．列挙型（列挙体）Enum

・Enumステートメント・列挙型（Enumステートメント）の使用例・列挙型（Enumステートメント）の活用について

第110回．ユーザー定義型・構造体（Type）

・Typeステートメントの構文・ユーザー定義型の使い方・ユーザー定義型の使用例・ユーザー定義型の制限・最後に

第111回．静的配列

・配列とは・静的配列と動的配列・配列の宣言・多次元配列・要素の下限の変更・配列について

第112回．動的配列（ReDim）

・ReDimステートメント・要素数の変更について・配列について

同じテーマ「VBA100本ノック」の記事

81本目：全フィルターの絞り込解除
 81本目：全フィルターの絞り込解除
 82本目：ブックのドキュメントプロパティを取得
83本目：請求書を作成してPDF出力
84本目：ブックの自動バックアップ
 85本目：請求日から入金予定日を算出
 86本目：全シートの総当たり表を作成
 87本目：数式のシート間の依存関係
 88本目：クロスABC分析作成
 89本目：2つのフォルダの統合
 90本目：セルに重なっている画像の削除

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
83本目：請求書を作成してPDF出力

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 83本目：請求書を作成してPDF出力