オリジナルな領収書作成のエクセルVBA　モジュール記述の全コード集

ryousyu_VBAkanseieyecatch

エクセルVBAを使って、オリジナルな領収書の作成を解説してきました。
ここで、各モジュールに記述するVBA全コードを一覧で紹介します。
VBAコード配置の確認に利用してください。

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

「領収書作成」の記事で紹介・解説しているエクセルVBAの全コード、

モジュールへの記述完了したものを記事に書いておきます。

自作時に、この「組み立て完成品」を参考にしてもらえればと思います。

標準モジュール（Module1）に書かれている全コード

receiptcodep001
VBA
'コード⑱ここから
    Public STA As Long
    Public STO As Long
    Public Arow As Variant
    Public Orow As Variant
    Public ErrNo As Long
'コード⑱ここまで
'コード⑪ここから
    Public Gen As String
    Public Nen As Variant
    Public Tuk As Variant
    Public Nit As Variant
'コード⑪ここまで
VBA
Sub 領収書作成()
'コード①ここから
    Dim aN As Long
    Dim aDay As String
    Dim aCusa As String
    Dim aCusb As String
    Dim aBill As Long
    Dim aTax As Long
    Dim aNote As String
    Dim anum As Integer
    Dim aBilln As String
'コード①ここまで
'コード②ここから
        Worksheets("発行データ入力").Select
        aR = ActiveCell.Row
'コード⑫ここから
        If Nen = "" Then Nen = "  "
        If Tuk = "" Then Tuk = "  "
        If Nit = "" Then Nit = "  "
        Range("B" & aR).Value = Gen & Nen & "年" _
                        & Tuk & "月" & Nit & "日"
        Range("H" & aR).Value = "済"
'コード⑫ここまで
        aN = Range("A" & aR).Value
        aDay = Range("B" & aR).Value
        aCusa = Range("C" & aR).Value
        aCusb = Range("D" & aR).Value
        aBill = Range("E" & aR).Value
        aTax = Range("F" & aR).Value
        aNote = Range("G" & aR).Value
'コード②ここまで
'コード⑤ここから
        anum1 = Len(CStr(aBill))
        x = anum1 \ 3
        Y = anum1 Mod 3
        If Y <> 0 Then
            P = x + 1
        Else
            P = x
        End If
'コード⑤ここまで
'コード⑥ここから
    Dim myBOX(5) As String
        If anum1 = 3 Or anum1 = 2 Or anum1 = 1 Then
            aBilln = CStr(aBill)
        Else
            For t = 0 To P - 1
                If Y <> 0 Then
                    If t = 0 And Y <> 0 Then
                        myBOX(0) = Mid(aBill, 1, Y)
                    Else
                        myBOX(t) = Mid(aBill, Y + 3 * _
                                        (t - 1) + 1, 3)
                    End If
                Else
                    If t = 0 Then
                        myBOX(0) = Mid(aBill, 1, 3)
                    Else
                        myBOX(t) = Mid(aBill, Y + 3 * _
                                        t + 1, 3)
                    End If
                End If
            Next t
            aBilln = Join(myBOX, ",")
        End If
        anum2 = Len(aBilln)
'コード⑥ここまで
'コード③ここから
        Worksheets("領収書").Select
        Range("T3") = aN
        Range("T25") = aN
        Range("R5") = aDay
        Range("R27") = aDay
        Range("C6") = aCusa
        Range("C7") = aCusb
        Range("C28") = aCusa
        Range("C29") = aCusb
'コード③ここまで
'コード⑦ここから
        For s = 0 To 15
            Cells(10, s + 5).Value = ""
            Cells(32, s + 5).Value = ""
        Next s
        Range("E10") = "￥"
        Range("E32") = "￥"
'コード⑦ここまで
'コード④ここから
        If aTax = 0 Then
            Range("G20") = " 円"
            Range("G42") = " 円"
            Range("H21") = " 円"
            Range("H43") = " 円"
        ElseIf aTax <> 0 Then
            Range("G20") = aBill - aTax & "円"
            Range("G42") = aBill - aTax & "円"
            Range("H21") = aTax & "円"
            Range("H43") = aTax & "円"
        End If
        Range("F13") = aNote
        Range("F35") = aNote
'コード④ここまで
'コード⑧ここから
        For i = 1 To anum2
            Cells(10, 5 + i).Value = Mid(aBilln, i, 1)
            Cells(32, 5 + i).Value = Mid(aBilln, i, 1)
        Next i
        If Y <> 0 Then
            Z = Y + 3 * (P - 1) + 1 + P - 1
        Else
            Z = Y + 3 * (P - 1) + 1 + 3 + P - 1
        End If
        
        Cells(10, Z + 5).Value = "－"
        Cells(32, Z + 5).Value = "－"
        
        For j = Z + 6 To 20
            Cells(10, j).Value = ""
            Cells(32, j).Value = ""
        Next j
'コード⑧ここまで
End Sub
VBA
Sub 宛名確認()      'コード⑭
    Dim PVa As String
        Worksheets("発行データ入力").Select
        aR = ActiveCell.Row
        PVa = Range("D" & aR).Value
        コントロールパネル.印刷宛名.Caption = PVa
End Sub
VBA
Sub 一件を印刷()    'コード⑯
        Call Module1.領収書作成
        Worksheets("領収書").PrintOut from:=1, To:=2, Preview:=True
        Worksheets("発行データ入力").Select
End Sub
VBA
Sub 領収書連続印刷準備()    'コード⑲
        ErrNo = 0
        STA = コントロールパネル.伝票番号始点.Value
        STO = コントロールパネル.伝票番号終点.Value
        Worksheets("発行データ入力").Select
        On Error GoTo Err_trap1
        Arow = WorksheetFunction.Match(STA, Range("A:A"), 0)
        On Error GoTo Err_trap2
        Orow = Application.WorksheetFunction _
                                .Match(STO, Range("A:A"), 0)
        If Arow > Orow Then
           MsgBox "伝票番号は昇順で指定してください。" _
                                        , vbYes, "メッセージ"
           Exit Sub
        End If
        Exit Sub
Err_trap1:
        MsgBox "印刷開始伝票番号が存在していません。" _
                                        , vbYes, "メッセージ"
        コントロールパネル.伝票番号始点.Value = ""
        コントロールパネル.伝票番号終点.Value = ""
        ErrNo = 1
        Exit Sub
Err_trap2:
        MsgBox "印刷終了伝票番号が存在していません。" _
                                        , vbYes, "メッセージ"
        コントロールパネル.伝票番号始点.Value = ""
        コントロールパネル.伝票番号終点.Value = ""
        ErrNo = 1
End Sub
VBA
Sub 領収書連続印刷実行()    'コード21ここから
        Call Module1.領収書連続印刷準備
        If ErrNo = 1 Then Exit Sub
        For n = Arow To Orow
            Worksheets("発行データ入力").Select
            Range("A" & n).Select
            Call Module1.領収書作成
            Worksheets("領収書").PrintOut from:=1, To:=2
        Next n
        Worksheets("発行データ入力").Select
        コントロールパネル.伝票番号始点.Value = ""
        コントロールパネル.伝票番号終点.Value = ""
'コード21ここまで
End Sub
目次へ戻る

シートモジュール（領収書）に書かれている全コード

receiptcodep002
VBA
Private Sub Worksheet_Activate()
        ActiveSheet.DrawingObjects.Delete
        With Worksheets("印影")
            .Range("J16:V20").Copy Worksheets("領収書").Range("K18:W22")
            .Range("J7:V11").Copy Worksheets("領収書").Range("K18:W22")
            .Range("J16:V20").Copy Worksheets("領収書").Range("K40:W44")
            .Range("J7:V11").Copy Worksheets("領収書").Range("K40:W44")
        End With
End Sub
VBA
Private Sub Worksheet_Deactivate()
        With Worksheets("領収書")
            .Range("K18:W22").ClearContents
            .Range("K40:W44").ClearContents
        End With
End Sub
目次へ戻る

シートモジュール（発行データ入力）に書かれている全コード

receiptcodep003
VBA
Private Sub Worksheet_Activate()
        If コントロールパネル.Visible Then Exit Sub
        コントロールパネル.Show vbModeless
End Sub
目次へ戻る

ブックモジュール（ThisWorkBook）に書かれている全コード

receiptcodep004
VBA
Private Sub Workbook_Open()
        If コントロールパネル.Visible Then Exit Sub
        コントロールパネル.Show vbModeless
End Sub
目次へ戻る

ユーザーフォームモジュール（コントロールパネル）に書かれている全コード

receiptcodep005
VBA
'コード⑩ここから
Private Sub 日付入力_Click()
        Gen = コントロールパネル.Controls("元号").Value
        Nen = コントロールパネル.Controls("ねん").Value
        Tuk = コントロールパネル.Controls("つき").Value
        Nit = コントロールパネル.Controls("にち").Value
End Sub
'コード⑩ここまで
VBA
'コード⑬
Private Sub 印刷宛名_Click()
        Call Module1.宛名確認
End Sub
VBA
'コード⑮
Private Sub 一件印刷_Click()
        Call Module1.一件を印刷
        コントロールパネル.印刷宛名.Caption = ""
End Sub
VBA
'コード⑰
Private Sub 入力確認ボタン_Click()
        If コントロールパネル.Controls("伝票番号始点") _
                                        .Value = "" Then
           MsgBox "印刷開始伝票番号がありません。", _
                                    vbOKOnly, "メッセージ"
           Exit Sub
        End If
        If コントロールパネル.Controls("伝票番号終点") _
                                        .Value = "" Then
           MsgBox "印刷終了伝票番号がありません。", _
                                    vbOKOnly, "メッセージ"
           Exit Sub
        End If
        コントロールパネル.番号確認.Caption = _
            Me.伝票番号始点.Value & "から" & _
            Me.伝票番号終点.Value & "まで印刷します。"
        Call Module1.領収書連続印刷準備
End Sub
VBA
'コード⑳
Private Sub 印刷開始_Click()
        rea = MsgBox("印刷を始めますか？", vbYesNo + _
                vbQuestion + vbDefaultButton2, "メッセージ")
        If rea = vbNo Then Exit Sub
        If コントロールパネル.Controls("伝票番号始点") _
                                            .Value = "" Then
           MsgBox "印刷開始伝票番号がありません。" _
                                    , vbOKOnly, "メッセージ"
           Exit Sub
        End If
        コントロールパネル.番号確認.Caption = _
                    Me.伝票番号始点.Value & "から" & _
                    Me.伝票番号終点.Value & "まで印刷します。"
        If コントロールパネル.Controls("伝票番号終点") _
                                                .Value = "" Then
           MsgBox "印刷終了伝票番号がありません。" _
                                        , vbOKOnly, "メッセージ"
           Exit Sub
        End If
        コントロールパネル.番号確認.Caption = _
                    Me.伝票番号始点.Value & "から" & _
                    Me.伝票番号終点.Value & "まで印刷します。"
        Call Module1.領収書連続印刷実行
        コントロールパネル.番号確認.Caption = ""
End Sub
目次へ戻る

まとめ

receiptcodep006

それぞれの記事毎に分解されたVBAコードは、コードつながり的に分かり辛いところも多いかと思います。

モジュール別にVBAコードをまとめて掲載しましたので、自作時に参考にしてください。

各記事中には触れていなかったコードも含まれています。

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

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

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

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

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

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

目次へ戻る

前の記事

VBACheckBoxeyecatch
シートへの【2種類のチェックボックス】の設置と使い方の違い

次の記事

Len関数・LenB関数で文字列の文字数を知る方法。使用例で解…
vbaleneyecatch