税別金額商品データを、テンプレートに落とし込むVBA

invoice3tenotoshieyecatch

税別価格に統一した商品データをテンプレートに落とし込みます。
税率別に合計金額を計算する、消費税額を計算する、登録した顧客データを帳票に自動表示するなどのVBAです。

こんにちは、じゅんぱ店長（@junpa33）です。

この記事での紹介は、

「外税計算」シートから商品データが「作業シート」に移された後の、「請求書」「納品書」「見積書」のテンプレートにデータを落とし込んで、帳票を完成させるところまでを行います。

「作業シート」でのデータのVBA処理が中心の内容となります。

インボイス見積納品請求3点伝票作成の記事編成

テンプレートにデータを落とす「作業シート」

invoice3tenotoship001

「作業シート」の開始設定は前の記事で紹介しています。

invoice3tenshseteyecatch 使用するワークシートの準備 インボイス見積納品請求伝票
invoice3tenshsetp01
目次へ戻る

テンプレにデータを落とすVBA設計

invoice3tenotoship002

「作業シート」の開始設定で、見出し行にコマンドボタンを設置しています。

  1. セルA1には「通番」
  2. セルB1には「非課税CHECKBOX」
  3. セルC1には「8%CHECKBOX」

これらのボタンには、「.OnAction=”〇〇〇”」によって標準モジュールで記述しているプロシージャーと関連付けを行っています。

今回は、この関連付けられたプロシージャーを作成し、更に「作業シート」のデータを加工しテンプレートに落とし込むVBAを作成します。

コードはModule2に記述していきます。

作業シートに設置したコマンドボタンのVBA

「通番」コマンドボタンの関連付けプロシージャー

関連付けのプロシージャー名は「通番再配置」です。

vbaendpropertyeyecatch Endプロパティで上下左右の最終セルを取得 fornextirekoeyecatch For～Nextのループと入れ子構造をVBA最速理解 vbawithstateeyecatch With～End Withの使い方。VBAコードを簡潔に記述する
VBA
Sub 通番再配置()
    Dim NoRow, i As Long
        If ActiveSheet.Name = "作業シート" Or ActiveSheet.Name = _
                    "外税計算" Then
            With ActiveSheet
                .Range("A:A").ClearContents
                NoRow = .Cells(Rows.Count, 5).End(xlUp).Row
                For i = 2 To NoRow
                    .Cells(i, 1) = i - 1
                Next i
            End With
        End If
End Sub

入力されている商品名の記述の最下行数をカウントして、A2セルを1として通し番号を振っていきます。

商品データを削除したり統合したり追加したりして、それまでに振られている通番が変わる時に「通番再配置」を実行します。（プログラムを動かす上ではこの通番が振られていることが必須です。）

「非課税CHECKBOX」コマンドボタンの関連付けプロシージャー

関連付けのプロシージャー名は「チェックボックス非配置」です。

VBACheckBoxeyecatch シートへの【2種類のチェックボックス】の設置と使い方の違い
VBA
Sub チェックボックス非配置()
    Dim SaRow, URow, i As Long
    Dim Tgrange As Range
    Dim CB As checkbox
        With Worksheets("作業シート")
            .Select
'作業シートでのデータ入力の最終行数
            SaRow = .Cells(Rows.Count, 5).End(xlUp).Row
'作業シートでの使用セルの最終行
            URow = .UsedRange.Rows.Count
        End With
'非課税チェックボックスを一旦削除
            Range(Cells(2, 2), Cells(URow, 2)).Select
            For Each Tgrange In Selection
                With Tgrange

                    For Each CB In Worksheets("作業シート").CheckBoxes
                        If Not Application.Intersect(CB.TopLeftCell, _
                                    Tgrange) Is Nothing Then
                            CB.Delete
                        End If
                    Next CB

                End With
            Next Tgrange
'非課税チェックボックスをデータ数だけ設置
        For i = 2 To SaRow
            With Cells(i, 2)
'各セルにチェックボックスを配置しセルのサイズを調整
                ActiveSheet.CheckBoxes.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .LinkedCell = Cells(i, 2).Address
                End With
'文字色を白色に変更
                .Font.Color = RGB(255, 255, 255)
            End With
        Next i
End Sub

「8%CHECKBOX」コマンドボタンの関連付けプロシージャー

関連付けのプロシージャー名は「チェックボックス8配置」です。

VBA
Sub チェックボックス8配置()
    Dim SaRow, URow, i As Long
    Dim Tgrange As Range
    Dim CB As checkbox
        With Worksheets("作業シート")
            .Select
'作業シートでのデータ入力の最終行数
        SaRow = Cells(Rows.Count, 5).End(xlUp).Row
'作業シートでの使用セルの最終行
            URow = .UsedRange.Rows.Count
        End With
'非課税チェックボックスを一旦削除
            Range(Cells(2, 3), Cells(URow, 3)).Select
            For Each Tgrange In Selection
                With Tgrange
                    For Each CB In Worksheets("作業シート").CheckBoxes
                        If Not Application.Intersect(CB.TopLeftCell, _
                                    Tgrange) Is Nothing Then
                            CB.Delete
                        End If
                    Next CB
                End With
            Next Tgrange
'非課税チェックボックスをデータ数だけ設置
        For i = 2 To SaRow
            With Cells(i, 3)
'各セルにチェックボックスを配置しセルのサイズを調整
                ActiveSheet.CheckBoxes.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .LinkedCell = Cells(i, 3).Address
                End With
'文字色を白色に変更
                .Font.Color = RGB(255, 255, 255)
            End With
        Next i
End Sub

商品データをテンプレに転記するVBA

ユーザーフォームの「テンプレ作成」ボタンで作成したテンプレートを、商品データ行数に合わせて伸縮させて使用します。

あらかじめ「請求書」「納品書」「見積書」シートにテンプレートが作成されてる必要はありません。

vbacellsbordereyecatch 「罫線」のVBAを最速理解 vbacellssyoshikieyecatch 「表示形式」をVBAコード的に最速理解する vbacellsplacementeyecatch 「配置」を最速理解する エクセルVBA vbacellsfonteyecatch 「フォント」の操作を最速理解する エクセルVBA vbaroundeyecatch Round関数の罠。VBAで数値を四捨五入する時の注意点 vbaroundupdowneyecatch RoundUpとRoundDown関数の使い方。数値の切り方に注意 vbacalleyecatch 部品化プロシージャーでCallステートメントは必須
VBA
Option Explicit

Public CellV As Long
Public Con10Tx, Con8Tx, ConNTx As Long
Public Sk10Tx, Sk8Tx As Long

Sub 帳票作成()
    Dim a, m, N, V, s, t As Long
    Dim GS, GSC As Long
    Dim SaRow, KeRow, IDRow As Long
    Dim Fsa, Fsb, SM As Variant
    Dim Con10TxSm, Con8TxSm, ConNTxSm As Long
        ThisWorkbook.Activate
        Worksheets("作業シート").Select
        SaRow = Cells(Rows.Count, 5).End(xlUp).Row
'罫線を引く行数範囲
        If SaRow < 23 Then
            KeRow = 40
        Else
            KeRow = 40 + Application.WorksheetFunction. _
                        RoundUp((SaRow - 23) / 34, 0) * 34
        End If
'請求納品見積へテンプレート再構築
        For a = 2 To 4
            Worksheets(a).Select
            With Worksheets(a)
'テンプレ合計欄を解消
                With .Range(.Cells(16, 2), .Cells(40, 9))
                    .ClearFormats
                    .ClearContents
                End With
'罫線設定、書式設定
                .Range("A15:I" & KeRow).Borders.LineStyle _
                            = xlContinuous
                .Range("C16:C" & KeRow).Font.Size = 10
                .Range("C16:C" & KeRow).WrapText = True
                .Range("D16:E" & KeRow).HorizontalAlignment = xlCenter
                For s = 16 To KeRow
                    .Range(.Cells(s, 6), .Cells(s, 7)).Merge
                Next s
                .Range("F16:H" & KeRow).NumberFormatLocal = "\ #,##0"
                .Range("B16:B" & KeRow).NumberFormatLocal = "m""/""d"
'品名のフォントサイズ
                Fsa = インボイス3点操作パネル.品名F.Value
                If Fsa = "" Then
                    Fsa = 10
                Else
                    Fsa = Val(Fsa)
                End If
                With .Range(Cells(16, 3), Cells(KeRow, 3))
                    .Font.Size = Fsa
                End With
'顧客名のフォントサイズ
                Fsb = インボイス3点操作パネル.顧客F.Value
                If Fsb = "" Then
                    Fsb = 13
                Else
                    Fsb = Val(Fsb)
                End If
                With .Range("B6").Font
                    .Size = Fsb
                    .Bold = True
                End With
'発行年月日のテンプレ転記
                With .Range("H1")
                    If インボイス3点操作パネル.発行年月日.Value = "" Then
                        .Value = "令和　　年　　月　　日"
                    Else
                        .Value = インボイス3点操作パネル.発行年月日.Value
                    End If
                    .Font.Size = 10
                End With
            End With
        Next a
'請求納品見積シートへデータ転記
        For a = 2 To 4
            With Worksheets(a)
                For N = 2 To SaRow
                    .Cells(N + 14, 1) = N - 1
                    If Worksheets("作業シート").Cells(N, 2) = True Then
                        .Cells(N + 14, 9) = 0
                    Else
                        If Worksheets("作業シート").Cells(N, 3) = _
                                    True Then
                            .Cells(N + 14, 9) = 8
                        Else
                            .Cells(N + 14, 9) = 10
                        End If
                    End If
                    For m = 4 To 9
                        If m = 8 Then
                            .Cells(N + 14, 6) = Worksheets("作業シート") _
                                        .Cells(N, 8)
                        ElseIf m = 9 Then
                            .Cells(N + 14, 8) = Worksheets("作業シート") _
                                        .Cells(N, 9)
                        Else
                            .Cells(N + 14, m - 2) = _
                                        Worksheets("作業シート").Cells(N, m)
                        End If
                    Next m
                Next N
                IDRow = .Cells(Rows.Count, 1).End(xlUp).Row
                Con10TxSm = 0
                Con8TxSm = 0
                ConNTxSm = 0
                Con10Tx = 0
                Con8Tx = 0
                ConNTx = 0
                For V = 16 To IDRow
                    With .Cells(V, 9)
                        SM = .Offset(0, -1)
                        If .Value = "10" Or .Value = "" Then
                            Con10TxSm = SM + Con10TxSm
                        ElseIf .Value = "8" Then
                            Con8TxSm = SM + Con8TxSm
                        ElseIf .Value = "0" Then
                            ConNTxSm = SM + ConNTxSm
                        End If
                    End With
                Next V
                With .Range(.Cells(SaRow + 15, 2), _
                                        .Cells(SaRow + 17, 2))
                    .Merge
                    .Value = "税抜き合計"
                    .WrapText = True
                    .Font.Size = 11
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                For s = 15 To 17
                    With .Cells(SaRow + s, 3)
                        .Font.Bold = True
                        If s = 15 Then .Value = "10%対象合計"
                        If s = 16 Then .Value = "8%対象合計"
                        If s = 17 Then .Value = "非課税対象合計"
                    End With
                    With .Range(.Cells(SaRow + s, 4), _
                                            .Cells(SaRow + s, 5))
                        .Merge
                        .Font.Bold = True
                        .NumberFormatLocal = "￥#,##0;[赤]-￥#,##0"
                        
                        If s = 15 Then .Value = Con10TxSm
                        If s = 16 Then .Value = Con8TxSm
                        If s = 17 Then .Value = ConNTxSm
                    End With
                    With .Cells(SaRow + s, 6)
                        .Value = "消費税額"
                        .Font.Bold = True
                    End With
                    With .Cells(SaRow + s, 8)
                        .Merge
                        If s = 15 Then
                            CellV = Con10TxSm
                            Call CulcruleB10(CellV)
                            .Value = Con10Tx
                        ElseIf s = 16 Then
                            CellV = Con8TxSm
                            Call CulcruleB8(CellV)
                            .Value = Con8Tx
                        ElseIf s = 17 Then
                            .Value = 0
                        End If
                        .NumberFormatLocal = "￥#,##0;[赤]-￥#,##0"
                        .Font.Bold = True
                    End With
                    With .Range(.Cells(SaRow + 15, 2), _
                                            .Cells(SaRow + 17, 8))
                        .BorderAround LineStyle:=xlContinuous, _
                                            Weight:=xlMedium
                    End With
                Next s
'金額合計を計算
                GS = Con10TxSm + Con8TxSm + ConNTxSm + Con10Tx + _
                                            Con8Tx + ConNTx
                GSC = Con10Tx + Con8Tx + ConNTx
                .Range("B12") = GS
                .Range("D12") = GSC
            End With
        Next a
 'フォント種選択（ユーザーフォームから選択）
        For a = 2 To 4
            With Worksheets(a)
                If インボイス3点操作パネル.ComboBox1.Value _
                                 = "" Then
                    .Cells.Font.Name = "ＭＳ Ｐゴシック"
                Else
                    .Cells.Font.Name = インボイス3点操作パネル _
                                .ComboBox1.Value
                End If
       
            End With
        Next a
'品名の個別フォントサイズ
                If インボイス3点操作パネル.CheckBox4 = True Then
                    Call Module3.番号別フォントサイズ
                End If
'別のプロシージャー呼び出し
        Call Module2.宛名設定
End Sub

罫線を引く行数範囲

帳票が使用するA4ページ数について、ページの印字範囲の最終行まで引く罫線の行数を設定しています。

2ページ以上にまたぐ場合は、プリントタイトルで必要になる行数を加味する必要があります。

KeRow = 40 + Application.WorksheetFunction. _
                        RoundUp((SaRow - 23) / 34, 0) * 34

テンプレ合計欄を解消

「テンプレ作成」で作ったページ下行の合計欄をクリアします。

罫線設定、書式設定

全体をザックリと設定します。

罫線を引く範囲に実線を引き、フォントサイズを10に、テキストの折り返し表示設定をします。

金額行では数値の金額表示設定を、日付欄では、月日の簡易表示を書式設定します。

品名のフォントサイズ、顧客名のフォントサイズ

ユーザーフォームで指定されたフォントサイズ変更を実行します。

無記入の場合は、品名のフォントサイズは10、顧客名のフォントサイズは13に設定します。

請求納品見積シートへデータ転記

帳票のテンプレートの税率行に「0」「8」「10」を商品毎に記入していきます。

For N = 2 To SaRow
　　.Cells(N + 14, 1) = N - 1
    If Worksheets("作業シート").Cells(N, 2) = True Then
        .Cells(N + 14, 9) = 0
    Else
        If Worksheets("作業シート").Cells(N, 3) = _
                    True Then
             .Cells(N + 14, 9) = 8
        Else
             .Cells(N + 14, 9) = 10
        End If
    End If

計算必要な数値以外のデータをテンプレートにはめ込んでいきます。

For m = 4 To 9
    If m = 8 Then
        .Cells(N + 14, 6) = Worksheets("作業シート") _
                    .Cells(N, 8)
    ElseIf m = 9 Then
        .Cells(N + 14, 8) = Worksheets("作業シート") _
                    .Cells(N, 9)
    Else
        .Cells(N + 14, m - 2) = _
                    Worksheets("作業シート").Cells(N, m)
    End If
Next m

税率別に商品の税別合計金額を計算します。

vbaoffseteyecatch Offsetプロパティは指定範囲を移動させる 
IDRow = .Cells(Rows.Count, 1).End(xlUp).Row
Con10TxSm = 0
Con8TxSm = 0
ConNTxSm = 0
Con10Tx = 0
Con8Tx = 0
ConNTx = 0
For V = 16 To IDRow
    With .Cells(V, 9)
        SM = .Offset(0, -1)
        If .Value = "10" Or .Value = "" Then
            Con10TxSm = SM + Con10TxSm
        ElseIf .Value = "8" Then
            Con8TxSm = SM + Con8TxSm
        ElseIf .Value = "0" Then
            ConNTxSm = SM + ConNTxSm
        End If
    End With
Next V

Functionプロシージャーで消費税の計算を行います。

With .Cells(SaRow + s, 8)
    .Merge
    If s = 15 Then
        CellV = Con10TxSm
        Call CulcruleB10(CellV)
        .Value = Con10Tx
    ElseIf s = 16 Then
        CellV = Con8TxSm
        Call CulcruleB8(CellV)
        .Value = Con8Tx
    ElseIf s = 17 Then
        .Value = 0
    End If
    .NumberFormatLocal = "￥#,##0;[赤]-￥#,##0"
    .Font.Bold = True
End With

宛名データをテンプレに落とし込むVBA

ユーザーフォームに顧客番号を指定することで、「宛名の登録」シートから登録データを調べて合致するものをテンプレートに表示します。

VBA
Sub 宛名設定()
    Dim a, ans As Long
    Dim CosNo As Variant
    Dim Res, Ybn, Jus, Ate As Variant
        Res = 0
        ThisWorkbook.Activate
        Worksheets("宛名の登録").Select
'インボイス3点操作パネルのデータより
        CosNo = インボイス3点操作パネル.顧客番号.Value
stepB:
'顧客番号が合致しない場合
        If CosNo = "" And MRK <> 2 Then
            MsgBox "顧客番号が入力されていません。", vbExclamation, _
                        "インボイス見積納品請求3点日付版作成"
            GoTo stepA
'顧客番号が合致する場合
        Else
            CosNo = Val(CosNo)
            On Error GoTo 0
            On Error Resume Next
            Res = WorksheetFunction.Match(CosNo, Range("B:B"), 0)
            If Res = 0 Then GoTo stepA
        End If
        Ybn = Range("D" & Res).Value     '郵便番号
        Jus = Range("E" & Res).Value     '住所
        Ate = Range("C" & Res).Value     '宛名
        For a = 2 To 4
            With Worksheets(a)
                    .Range("B3") = Ybn
                    .Range("B4") = Jus
                    .Range("B6") = Ate & "　　様"
            End With
        Next a
'顧客データが見つからない時の処理
stepA:
        If Res = 0 Then
            ans = MsgBox("一致する顧客番号はありません。" & vbCrLf & _
                        "正しい番号を入力しますか？", vbYesNo + _
                        vbQuestion, "インボイス見積納品請求3点日付版作成")
            If ans = vbYes Then
                CosNo = InputBox(Prompt:="半角数字で顧客番号を" & _
                        vbCrLf & "入力してください。", Title:= _
                        "インボイス見積納品請求3点日付版作成")
                インボイス3点操作パネル.顧客番号.Value = CosNo
                GoTo stepB
            Else
                MsgBox "宛名空欄で終了します", vbInformation, _
                        "インボイス見積納品請求3点日付版作成"
                Worksheets("請求書").Select
                Range("A1").Select
                Exit Sub
            End If
        End If
        Worksheets("請求書").Select
        Range("A1").Select
        MsgBox "3点伝票の作成が完了しました。", vbInformation, _
            "インボイス見積納品請求3点日付版作成"
End Sub

顧客番号が合致しない場合

ユーザーフォームで指定した顧客番号が「宛名の登録」シートに存在しない場合は、Gotoステートメントで「stepA」にジャンプします。

顧客番号が合致する場合

「宛名の登録」シートの合致したデータをテンプレートに転記し表示します。

顧客データが見つからない時の処理

「stepA」にジャンプして来た時の処理です。

顧客番号を入力して進めるか、顧客番号を入力せずに、宛先を「空白」にして進めるかを指定します。

顧客番号を入力する場合は、インプットボックスが表示されて、「顧客番号が合致する場合」のコード進行に移ります。

その上で更に、顧客番号が見つからない場合は、再び「stepA」にジャンプして操作のやり直しとなります。

目次へ戻る

商品データをテンプレートに落とし込む　まとめ

invoice3tenotoship003

税別価格に統一した商品データを整理してテンプレートに落とし込むVBAを説明しました。

これで帳票作成のための印刷（紙化、PDF）の準備は完了です。

次回以降は、印刷用に体裁を整えるためのVBAを説明して行きます。

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう！

エクセルVBA業務ツールで日常の業務改善を行いましょう。

＜記事内容についての告知＞

VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。

目次へ戻る

アンケートでポイ活しよう!!

アンケートに答えれば答えるほど ”使える” ポイントがたまります。

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

invoice3tenzeibetueyecatch
商品代を税別金額で揃えるためのVBA 3点伝票日付版

次の記事

印刷設定を行うVBA インボイス見積納品請求伝票日付版
invoice3tenprinteyecatch