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

ryousyu_VBAkanseieyecatch

エクセル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です。

また、一般的に領収書によく使われている用紙は、コピー用紙よりも結構厚手になっています。

このエクセルソフトの印刷用の用紙を色々探してみましたが、

厚手タイプで白色すぎず領収書用紙として自分的には一番しっくり来ている用紙があります。

領収書用紙にはちょうどいい感じです。コピー用紙として探しても見つからない場合はおすすめです。(少数の枚数のものもあり)

 

ペーパーミツヤマ 書籍用紙 淡クリームキンマリ 4/6 90kg 104.7g/㎡ A6 2000枚

 

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

 

「VBA最速理解」の記事一覧を開く