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

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-22

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


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


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA100本ノック

マクロ VBA100本ノック

マクロ VBA100本ノック


サンプルファイルです。
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本目:セルに重なっている画像の削除


新着記事NEW ・・・新着記事一覧を見る

TOROW関数(配列を横1行の配列にして返す)|エクセル入門(2022-10-31)
TOCOL関数(配列を縦1列の配列にして返す)|エクセル入門(2022-10-31)
CHOOSECOLS関数(配列から複数の指定された列を返す)|エクセル入門(2022-10-29)
CHOOSEROWS関数(配列から複数の指定された行を返す)|エクセル入門(2022-10-29)
WorksheetFunctionの効率的な使い方とスピル新関数の利用|VBA入門(2022-10-27)
VSTACK関数(配列を縦方向に順に追加・結合)|エクセル入門(2022-10-25)
HSTACK関数(配列を横方向に順に追加・結合)|エクセル入門(2022-10-25)
LAMBDA以降の新関数の問題と解説(配列操作関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題と解説(ヘルパー関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題集|エクセル入門(2022-10-24)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.マクロって何?VBAって何?|VBA入門
9.エクセルVBAでのシート指定方法|VBA技術解説
10.ExcelマクロVBAの基礎を学習する方法|エクセルの神髄




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


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



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