エクセルVBAを使って、オリジナルな領収書の作成を解説してきました。
ここで、各モジュールに記述するVBA全コードを一覧で紹介します。
VBAコード配置の確認に利用してください。
こんにちは、じゅんぱ店長（@junpa33）です。
「領収書作成」の記事で紹介・解説しているエクセルVBAの全コード、
モジュールへの記述完了したものを記事に書いておきます。
自作時に、この「組み立て完成品」を参考にしてもらえればと思います。
コンテンツ
標準モジュール（Module1）に書かれている全コード
コード
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 'コード⑪ここまで
'コード①ここから
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
Sub 宛名確認() 'コード⑭
Dim PVa As String
Worksheets("発行データ入力").Select
aR = ActiveCell.Row
PVa = Range("D" & aR).Value
コントロールパネル.印刷宛名.Caption = PVa
End Sub
Sub 一件を印刷() 'コード⑯
領収書作成
Worksheets("領収書").PrintOut from:=1, To:=2, Preview:=True
Worksheets("発行データ入力").Select
End Sub
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
Sub 領収書連続印刷実行() 'コード21ここから
領収書連続印刷準備
If ErrNo = 1 Then Exit Sub
For n = Arow To Orow
Worksheets("発行データ入力").Select
Range("A" & n).Select
領収書作成
Worksheets("領収書").PrintOut from:=1, To:=2
Next n
Worksheets("発行データ入力").Select
コントロールパネル.伝票番号始点.Value = ""
コントロールパネル.伝票番号終点.Value = ""
'コード21ここまで
End Sub
シートモジュール（領収書）に書かれている全コード
コード
Private Sub Worksheet_Activate()
ActiveSheet.DrawingObjects.Delete
Worksheets("印影").Range("J16:V20").Copy Sheets("領収書").Range("K18:W22")
Worksheets("印影").Range("J7:V11").Copy Sheets("領収書").Range("K18:W22")
Worksheets("印影").Range("J16:V20").Copy Sheets("領収書").Range("K40:W44")
Worksheets("印影").Range("J7:V11").Copy Sheets("領収書").Range("K40:W44")
End Sub
Private Sub Worksheet_Deactivate()
Sheets("領収書").Range("K18:W22").ClearContents
Sheets("領収書").Range("K40:W44").ClearContents
End Sub
シートモジュール（発行データ入力）に書かれている全コード
コード
Private Sub Worksheet_Activate()
If コントロールパネル.Visible Then Exit Sub
コントロールパネル.Show vbModeless
End Sub
ユーザーフォームモジュール（コントロールパネル）に書かれている全コード
コード
Private Sub 日付入力_Click() 'コード⑩ここから
Gen = コントロールパネル.Controls("元号").Value
Nen = コントロールパネル.Controls("ねん").Value
Tuk = コントロールパネル.Controls("つき").Value
Nit = コントロールパネル.Controls("にち").Value
End Sub
'コード⑩ここまで
Private Sub 印刷宛名_Click() 'コード⑬
宛名確認
End Sub
Private Sub 一件印刷_Click() 'コード⑮
一件を印刷
End Sub
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 & "まで印刷します。"
領収書連続印刷準備
End Sub
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 & "まで印刷します。"
領収書連続印刷実行
End Sub
印刷用紙について
A6サイズは、A4サイズの1/4です。
また、一般的に領収書によく使われている用紙は、コピー用紙よりも結構厚手になっています。
このエクセルソフトの印刷用の用紙を色々探してみましたが、
厚手タイプで白色すぎず領収書用紙として自分的には一番しっくり来ている用紙があります。
領収書用紙にはちょうどいい感じです。コピー用紙として探しても見つからない場合はおすすめです。（少数の枚数のものもあり）
＜記事内容についての告知＞VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。
