「処理ごとの解説ではなく、完成品の全体が見たい!」
という方のための、完成品マクロのサンプルコードです。
今回のテーマは「データシート ⇒ 帳票への印字・出力」です。
帳票は請求書や納品書などなんでもありですね。
実務の登場頻度が高く、ワークシート関数だけでは自動化が難しいので、
多くの人の「VBAを勉強したいと思うきっかけ」になっているくらい、
メジャーな処理です。
なお、本コードは、
- 関数(プロシージャ)分割の方法を勉強をしたい方
- メンテナンス性を意識したコードのサンプルが欲しい方
を対象に、マクロをパーツごとに分けて作り、
それを組み立てて完成させる様子がわかるように組みました。
複雑なマクロを書けるようになってきて、
「コードがごちゃごちゃしてきたのを整理したいな~」
と思っている方は、参考にしてみてください。
マクロの仕様について
以下のデータシートから、帳票「領収書」を出力します。
◇ データシート
◇ 領収書
サンプルに「領収書」を使いましたが、
「見積書」「請求書」など、帳票ならなんでも行けます。
ひとまず、
「データシート」「領収書のテンプレート」
の2シートからなるブックにマクロを書いていきますが、
いずれ変わってもいいようにコードを書いていきます。
「出力」の方法ですが、J列「出力」をユーザーに操作してもらい、
- ダブルクリックしたデータを新しいブックに出力
- 「1」を立てたデータを1つのブックにまとめて一括出力
- 「1」を立てたデータをそれぞれ別のブックに一括保存
する3パターンを用意しました。
お好きなものをご参考ください。
ソースコード
標準モジュール「Df_購入歴データ」
Option Explicit ' 購入歴データのシートレイアウト Public Const Adrs購入歴データ_年度 = "E2" Public Const R1st購入歴データ = 5 Public Enum CNo購入歴データ No = 2 月 日 購入者 品物 価格 個数 お支払い 出力 End Enum Public Const CLast購入歴データ = CNo購入歴データ.出力 ' 指定行の購入日の計算 Function GetDate購入歴データ_購入日(ws As Worksheet, R As Long) As Date With ws ' 空データは除外 If .Cells(R, CNo購入歴データ.月) ="" _ Or .Cells(R, CNo購入歴データ.日) = "" Then Exit Function End If ' 年度と月から年を取得 Dim y As Long: y = Left(.Range(Adrs購入歴データ_年度), 4) If .Cells(R, CNo購入歴データ.月) <= 3 Then y = y + 1 ' シリアル値で返す GetDate購入歴データ_購入日 = DateSerial _ (y, .Cells(R, CNo購入歴データ.月), .Cells(R, CNo購入歴データ.日)) End With End Function
購入歴データのシートレイアウト(行・列番号の一覧)を定数定義したモジュールです。
定数定義にはEnum(列挙型定数)を使用しています。
月、日、年度がすべて別のセルになっているシートのため、
各マクロで「購入日」をいちいち計算しなくて済むよう、
これも定数モジュール内で関数化しておきます。
Debug.Print GetDate購入日(ActiveSheet, 7) ' ← 2020/8/1 が返る
シートの定義部分をモジュールに切り分けているのは、
- これだけで独立していることを明示
- 広域の定数をどのモジュールで定義したか忘れる問題の対策
- 他のファイルで使うときにコピーが楽
あたりが理由です。
なお、モジュール名に接頭した「Df_」は定義の意味ですが、
割と意味はどうでもよく、単にモジュールの並び順をコントロールしたいだけです。
標準モジュール「Pr_請求書←購入歴」
Option Explicit ' 領収書のセルアドレス Public Const Adrs領収書_No = "D3" Public Const Adrs領収書_購入者 = "C7" Public Const Adrs領収書_購入日 = "G3" Public Const Adrs領収書_お支払い = "F9" Public Const Adrs領収書_品物 = "F11" ' 領収書シート←購入歴シート Sub 購入歴データの指定行を領収書シートに印字する(wsデータ As Worksheet, R As Long _ , ws印字シート As Worksheet) With ws印字シート .Range(Adrs領収書_No) = wsデータ.Cells(R, CNo購入歴データ.No) .Range(Adrs領収書_購入者) = wsデータ.Cells(R, CNo購入歴データ.購入者) .Range(Adrs領収書_購入日) = GetDate購入歴データ_購入日(wsデータ, R) .Range(Adrs領収書_品物) = wsデータ.Cells(R, CNo購入歴データ.品物) .Range(Adrs領収書_お支払い) = wsデータ.Cells(R, CNo購入歴データ.お支払い) End With End Sub
「データシートのR行目」⇒「領収書シート」という、
今回の核となる処理のコードを関数に分離し、
モジュールとしても独立しておきます。
マクロが複雑になるのは、ユーザーと対話したり、複数パターンを用意することになる「実行用の処理」で起こることが多いです。
このとき、実行方法によらない核の部分だけを↑の例のように抽出しておくと、実行用のプロシージャが格段に書きやすくなります。
シートモジュール「WS購入歴データ」
「ダブルクリックしたデータを新しいブックに出力」パターンの実行用コードです。
↑この「⇒」をダブルクリックしてもらうイメージ。
とりあえず、マクロを書くブックと、データ・帳票テンプレートが同じブックにあるので、
シート名 | オブジェクト名 |
---|---|
購入歴データ | WS購入歴データ |
領収書テンプレート | TplWS領収書 |
というオブジェクト名を設定した上で、そのシートモジュールに以下のコードを書きます。
' ダブルクリック時 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim R As Long: R = Target.Row Dim C As Long: C = Target.Column ' 列ごとのイベント If R >= R1st購入歴データ Then Select Case C ' 領収書の出力 Case CNo購入歴データ.出力 If Cells(R, CNo購入歴データ.お支払い) = 0 Then MsgBox("支払いが済んでいないデータは出力できません。") Else Call 購入歴データの指定行を領収書シートに印字する _ (Me, R, シートを新しいブックへコピーする(TplWS領収書)) MsgBox ("領収書の出力を完了しました。") Cancel = True End If End Select End If End Sub
対象のエリアをダブルクリックして、その行のお支払いが済んでいれば、
先ほどのメインコードを実行します。
ちょっと書き方が冗長(1分岐なのにSelect Caseとか)なのは、
「ダブルクリック実行用のコードテンプレート」を用意しておき、
それを編集したからです。
イベントプロシージャは改修の連発で複雑怪奇になりやすいので、
初めからある程度整形しておきましょう。
今回の例では、初めからSelect Caseにしておくことで、
別のイベントを追加するのがかなり簡単になります。
メインプロシージャと一緒に呼んでいる関数「シートを新しいブックへコピーする」は、以下のモジュールから使用します。
標準モジュール「Ut_汎用関数」
' テンプレートシート⇒新しいブック Function シートを新しいブックへコピーする(指定シート As Worksheet) As Worksheet ' コピー元シートが非表示であれば表示 Dim is元シートが非表示 As Boolean: is元シートが非表示 = Not (指定シート.Visible) If is元シートが非表示 Then 指定シート.Visible = True ' コピー 指定シート.Copy Set シートを新しいブックへコピーする = ActiveSheet ' 表示状態の復元 If is元シートが非表示 Then: 指定シート.Visible = False End Function
このモジュールは、この関数だけが置いてあるわけではなく、
「今回使わない関数もたくさん書いてある」場所だと思ってください。
どんなマクロでも使える関数をこの「汎用関数モジュール」に書いておき、複数のファイルで共用します。
今回使った汎用関数は1つだけです。
ワークシート.Copyは、WorkSheets.Addと違い、Worksheetオブジェクトを返してくれないのが不便です。
' これはいい感じ Set ws処理シート = Worksheets.Add ' これが面倒 コピー元シート.Copy Set ws処理シート = ActiveSheet
この面倒を回避するための関数です。
Set ws処理シート = シートを新しいブックへコピーする(コピー元シート)
と書けるようになりますし、
今回のメインコードの呼び出し方のように、
Call 購入歴データの指定行を領収書シートに印字する _ (Me, R, シートを新しいブックへコピーする(TplWS領収書))
と、Worksheetオブジェクトを引数に取る関数に直接投げ込むことができるようになります。
またこの関数には、一緒に行うことの多い処理
「非表示シートだったら、表示してからCopyして、後で非表示に戻す」
も同梱しています。
領収書テンプレートのシートを表示していると、
そのシートに直接値を書いて印刷する不届きものが現れます。
それを非表示でやることが多い方は、こんな風に汎用関数に入れておくことで、
同じコードを何度も書く必要がなくなりますね。
この「テンプレートを守る対策」を、例に挙げたシートの非表示ではなく「シートの保護」でやることが多い人は、同じ様に「Protect」「Unprotect」メソッドを関数に入れておくと便利です。
ここまでのまとめ
以上が「ダブルクリックで1枚ずつ出力」パターンの全コードになります。
関数分割+モジュール分割で意識したポイントは、
- シートのレイアウト定数はモジュールに分けておく
- 核となる処理は実行用のコードから切り出しておく
- 実行用のプロシージャはテンプレート化しておき難読化を防ぐ
- 汎用関数は1つのモジュールにして使いまわす
あたりでしたね。
プロシージャ分割を行う一番の理由は、
「読みやすいコード」「変更に強いコード」にすることです。
読みやすさ、変更の内容は、時と場合によって様々ですので、
「正解はこれ!」なんてのはもちろんありません。
あくまで「私の書き方」ですので、1つ参考にして、自分流を磨いていただければと思います。
ユーザーが選択した複数のデータを一括出力する
ではここからは残りのパターン
- 「1」を立てたデータを1つのブックにまとめて出力し保存
- 「1」を立てたデータをそれぞれ別のブックに一括保存
を紹介していきます。
いずれも、
こんなイメージで実行します。
標準モジュール「Ex_選択レコード→1ブック」
「出力した領収書シートを、1つのブックにまとめて保存」タイプです。
出来上がったブックで「ブック全体を印刷」すれば、一括印刷ができますね。
PrintOutメソッドをループで連続実行するのは怖いので、
一括印刷したい場合も、このマクロを使用しましょう。
' 選択データ⇒1つのブック Sub 購入歴データの選択データを1ブックにまとめて領収書に出力する() ' ユーザー入力チェック If Isユーザーの出力指定にエラーがあれば警告を表示する Then Exit Sub ' フォルダはダイアログボックスでユーザーより選択 Dim Path出力先フォルダ As String Path出力先フォルダ = GetPathダイアログボックスでフォルダを選択する If Path出力先フォルダ = "" Then MsgBox ("フォルダが指定されませんでしたので、処理を中断します。") Exit Sub End If Call エクセルの自動更新を停止する(False) TplWS領収書.Visible = True ' 出力先ブックを生成 Dim wb出力先ブック As Workbook Set wb出力先ブック = Workbooks.Add ' 出力列が1のデータを走査 With WS購入歴データ Dim R As Long For R = R1st購入歴データ To GetRLast_オートフィルター(WS購入歴データ) If .Cells(R, CNo購入歴データ.出力) = 1 Then ' 出力先ブックの最終シートにテンプレートをコピーして印字 TplWS領収書.Copy After:=Get最終シート(wb出力先ブック) Call 購入歴データの指定行を領収書シートに印字する(WS購入歴データ, R, Get最終シート(wb出力先ブック)) ' シート名は請求書Noに Get最終シート(wb出力先ブック).Name = .Cells(R, CNo購入歴データ.No) .Cells(R, CNo購入歴データ.出力) = "済" End If Next End With ' 出力列が1のデータを走査 ' ブックAdd時の空シートを削除 Application.DisplayAlerts = False wb出力先ブック.Worksheets(1).Delete Application.DisplayAlerts = True ' ブックを保存する wb出力先ブック.SaveAs Path出力先フォルダ & "\領収書一括出力ファイル_" _ & Format(Now, "yymmddhhmm") & ".xlsx" TplWS領収書.Visible = False Call エクセルの自動更新を開始する MsgBox ("領収書の一括出力を完了しました。") wb出力先ブック.Worksheets(1).Activate End Sub ' ユーザー警告 Private Function Isユーザーの出力指定にエラーがあれば警告を表示する() As Boolean With WS購入歴データ Dim 出力指定エリア As Range Set 出力指定エリア = Intersect(.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count-1), .Columns(CNo購入歴データ.出力)) End With Dim 出力データ数 As Long 出力データ数 = WorksheetFunction.CountIf(出力指定エリア, 1) If 出力データ数 = 0 Then MsgBox ("出力データが選択されていません。") Isユーザーの出力指定にエラーがあれば警告を表示する = True Exit Function End If If 出力データ数 > 20 Then If MsgBox("出力対象データが20件を超えています。(" & 出力データ数 & "件)" & vbCrLf & _ "このまま出力を実行してよろしいですか?", vbYesNo + vbDefaultButton2) = vbNo Then Isユーザーの出力指定にエラーがあれば警告を表示する = True Exit Function End If End If End Function
細かい中身の解説は割愛します。
プロシージャ分割のポイントとしては、
「ユーザーの入力チェックを、最終的な合否を返す関数にして切り出す」
ことで、メインコードのスタートをキレイにしています。
汎用関数はこれらを使っています。
' マクロ高速化開始 Sub エクセルの自動更新を停止する(ブック計算をOFF As Boolean _ , Optional 画面更新をOFF As Boolean = True, Optional イベントをOFF As Boolean = True) With Application If ブック計算をOFF Then .Calculation = xlCalculationManual If 画面更新をOFF Then .ScreenUpdating = False If イベントをOFF Then .EnableEvents = False End With End Sub ' マクロ高速化終了 Function エクセルの自動更新を開始する() With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True .EnableEvents = True .StatusBar = False .DisplayAlerts = True End With End Function ' テンプレートシート⇒新しいブック Function シートを新しいブックへコピーする(指定シート As Worksheet) As Worksheet ' コピー元シートが非表示であれば表示 Dim is元シートが非表示 As Boolean: is元シートが非表示 = Not (指定シート.Visible) If is元シートが非表示 Then 指定シート.Visible = True ' コピー 指定シート.Copy Set シートを新しいブックへコピーする = ActiveSheet ' 表示状態の復元 If is元シートが非表示 Then: 指定シート.Visible = False End Function ' オートフィルターの最終行 Function GetRLast_オートフィルター(指定シート As Worksheet) As Long With 指定シート GetRLast_オートフィルター = .Range(.Cells(1, 1), .AutoFilter.Range).Rows.Count End With End Function ' ブック内最終シート Function Get最終シート(指定ブック As Workbook) As Worksheet Set Get最終シート = 指定ブック.Worksheets(指定ブック.Worksheets.Count) End Function ' フォルダの選択 Function GetPathダイアログボックスでフォルダを選択する(Optional Path初期表示フォルダ As String = "") As String With Application.FileDialog(msoFileDialogFolderPicker) If Path初期表示フォルダ <> "" Then .InitialFileName = Path初期表示フォルダ If .Show Then: GetPathダイアログボックスでフォルダを選択する = .SelectedItems(1) End With End Function
どれもよくある処理をまとめているだけです。
おすすめは「最終シートの取得」です。
1行関数ですがなかなか便利ですよ。
Copy After:= ws出力シート.Parent.Worksheets(ws出力シート.Parent.Worksheets.Count) Copy After:= Get最終シート(ws出力シート.Parent)
こういう同じコードを短い区間で繰り返すのが嫌いな人は是非。
標準モジュール「Ex_選択レコード→別ブック」
最後に「出力した領収書を、それぞれ別のブックに保存」タイプです。
領収書でこれをやるのはあまりないかもしれませんが、
出来上がった帳票を、ファイルで配るような場合はこの手法を使いますね。
Option Explicit ' 選択データ⇒別のブック Sub 購入歴データの出力指定行をそれぞれ別のブックの領収書に一括出力する() ' ユーザー入力チェック If Isユーザーの出力指定にエラーがあれば警告を表示する Then Exit Sub ' フォルダはダイアログボックスで選択してもらう Dim Path出力先フォルダ As String Path出力先フォルダ = GetPathダイアログボックスでフォルダを選択する If Path出力先フォルダ = "" Then MsgBox ("フォルダが指定されませんでしたので、処理を中断します。") Exit Sub End If Call エクセルの自動更新を停止する(False) TplWS領収書.Visible = True ' 出力列が1のデータを走査 With WS購入歴データ Dim R As Long For R = R1st購入歴データ To GetRLast_オートフィルター(WS購入歴データ) If .Cells(R, CNo購入歴データ.出力) = 1 Then ' 新規ブックにテンプレートをコピーして印字 Dim ws出力シート As Worksheet Set ws出力シート = シートを新しいブックへコピーする(TplWS領収書) Call 購入歴データの指定行を領収書シートに印字する(WS購入歴データ, R, ws出力シート) ' ブック名を「領収書No_yyyymmdd.xlsx」で保存 ws出力シート.Parent.SaveAs Path出力先フォルダ & "\領収書No" _ & .Cells(R, CNo購入歴データ.No) & "_" _ & Format(ws出力シート.Range(Adrs領収書_購入日), "yyyymmdd") & ".xlsx" ' 生成ブックは閉じる ws出力シート.Parent.Close False End If Next End With ' 出力列が1のデータを走査 TplWS領収書.Visible = False Call エクセルの自動更新を開始する MsgBox ("領収書の一括出力を完了しました。") End Sub
同じく解説は割愛しますね。
ユーザー入力チェックと、汎用関数は、「1ブックパターン」と同じものなのでそちらをコピーしてください。
ちなみに、長くなるため今回は採用しませんでしたが、
「ブック名を「領収書No_yyyymmdd.xlsx」で保存」
のように、データの値を使ってブック名を作る場合、
ブック名のダブリによる「上書き対策」が必要になることがあります。
今回の「No」のように、ユニークな列があればいいのですが、
そうでない場合は、
Call 保存ブック名が重複した場合はブック名に連番を付与して保存する _ (wb保存ブック, FullPath保存ファイル名)
こんな汎用関数を用意しておくと、ファイル名が存在しないファイル名になるまで連番を足しながら変えていくような面倒な処理を、2度と書かなくて済むようになるのでおすすめです。
まとめ
今回は「データシート⇒何かの帳票への印字・出力・印刷」マクロを、
- 関数(プロシージャ)分割の方法を勉強をしている方
- メンテナンス性を意識したコードのサンプルが欲しい方
のために、
- ダブルクリックしたデータを新しいブックに出力
- 「1」を立てたデータを1つのブックにまとめて出力し保存
- 「1」を立てたデータをそれぞれ別のブックに一括保存
のサンプルコードにして掲載しました。
関数分割+モジュール分割で意識したポイントは、
- シートのレイアウト定数はモジュールに分けておく
- 核となる処理は実行用のコードから切り出しておく
- 実行用のプロシージャはテンプレート化しておき難読化を防ぐ
- 汎用関数は1つのモジュールにして使いまわす
あたりでしたね。
特に大事なのが、2番目の「核となる処理は実行用のコードから切り出しておく」です。
実行モジュールを3パターン作る際、
いずれのパターンでも「データ⇒領収書」が1行で済んでいることで、
機能のバリエーションを増やすのが格段に楽になっていることが分かります。
この辺を意識してみると、「どこを関数に分けるか」がなんとなくわかってくるのではないかと思います。
大事なことなので2回書きますが、
プロシージャ分割を行う一番の理由は、
「読みやすいコード」「変更に強いコード」にすることです。
読みやすさ、変更の内容は時と場合によって様々ですから、
「正解はこれ!」なんてものはありません。
あくまで「私の書き方」ですので、1つ参考にして、
自分流を磨いていただければと思います。
おまけ:孤独なVBAプログラマ
事務職が目の前の雑務と戦うのが主戦場のExcelVBAでは、
チーム開発はおろか、そもそも1人で戦うVBAエンジニアさんが多いです。
プログラミングが基本独学なのはすべての言語で共通だと思いますが、
「人のコードを見て答え合わせ」の機会すら訪れにくいのは、
VBAのつらいところですね。
ということで、全体を通して「これが答え」なんて口が裂けても言えませんが、
部分的には、
「あっ、この書き方の方がいいじゃん!」
と気付いていただけた部分もあったのではないかと思います。
そんなところを1つでも持ち帰っていただければ幸いです。
が、こちらからもひとつお願いが。
「あっ、俺の書き方の方がいいじゃん!」
っていう部分がありましたら、
私の答え合わせにも付き合ってください。
私も普段1人で戦っているので、
たまにさみしくなってしまうのです。
Twitterでもブログコメント欄でもいいので、
ご連絡いただけると飛び上がって喜びます。
気が向いたらでいいので、よろしくお願いいたします(`・ω・´)