エクセルVBAを使って、オリジナルな領収書の作成を解説してきました。
ここで、各モジュールに記述するVBA全コードを一覧で紹介します。
VBAコード配置の確認に利用してください。
こんにちは、じゅんぱ店長(@junpa33)です。
「領収書作成」の記事で紹介・解説しているエクセルVBAの全コード、
モジュールへの記述完了したものを記事に書いておきます。
自作時に、この「組み立て完成品」を参考にしてもらえればと思います。
コンテンツ
標準モジュール(Module1)に書かれている全コード
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
シートモジュール(領収書)に書かれている全コード
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
シートモジュール(発行データ入力)に書かれている全コード
VBA
Private Sub Worksheet_Activate()
If コントロールパネル.Visible Then Exit Sub
コントロールパネル.Show vbModeless
End Sub
ブックモジュール(ThisWorkBook)に書かれている全コード
VBA
Private Sub Workbook_Open()
If コントロールパネル.Visible Then Exit Sub
コントロールパネル.Show vbModeless
End Sub
ユーザーフォームモジュール(コントロールパネル)に書かれている全コード
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
まとめ
それぞれの記事毎に分解されたVBAコードは、コードつながり的に分かり辛いところも多いかと思います。
モジュール別にVBAコードをまとめて掲載しましたので、自作時に参考にしてください。
各記事中には触れていなかったコードも含まれています。
エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。
エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です今回の記事はここまでです。 最後までご覧いただき有難うございました。
<記事内容についての告知>
VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。
アンケートでポイ活しよう!!
アンケートに答えれば答えるほど ”使える” ポイントがたまります。