【エクセルVBA】請求書を取引先別でまとめて作成【VBAファイル有】

こんにちわ、しょーい(@showilog)です。
私は仕事上見積書・請求書を大量に作ってます。
毎月大量の請求書を1枚ずつ作成していた時期があったのですが、時間がいくらあっても足りない・・・。

けどVBAを学んだあとは、大量の請求書PDFを一瞬で生成出来る様になりました。
手作業 10時間　→　VBA　1分
これくらいに変化がありました。

・毎月請求書の作成依頼が大変
・見積を毎回依頼される度に時間が奪われる・・・
・1個ずつ手作業がムダすぎる

こんなことを思っている人たちを救いたい！という理由で今回のマクロを作成しました。
是非使える方は使っていただきたいです。

請求書の書き方

まずは基本に立ち返ってみます。

請求書作成のルール

実は請求書を作る際に明確なルールは存在しないんです。
なぜかと言うと、請求書に法律で決まっていることがないからなんです。

会社独自のフォーマットなどがあるのは、会社で「これでいこう」と決めているからですね。
なので使いにくい請求書フォーマットをずーっと使っている会社もけっこうあったりします。

請求書作成時の注意点

ルールは無いと言っても、スムーズな取引をするためには請求書を受け取る側がわかりやすい内容なのが一番です。

・取引内容
・取引日時
・消費税金額、税込金額
・請求する方の情報（会社情報等）
・振込先情報

上記があれば取引先もスムーズに振込処理を進めてくれると思います。
特段指定がない限りは、Excelに最初から入っているフォーマットでも問題ないです。

請求書をまとめて発行する方法

今回のExcelの仕様は
「データベースから請求書をブック別で作成・PDFとExcelファイルとして保存」する仕様です。

請求書をまとめて発行するVBA

VBAコード

こちらは標準モジュール

Sub 新規請求書用ブック作成(terget)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    Dim EndDay As Date
    
    EndDay = Year(Date) & "/" & Month(Date) & "/" & 1
    EndDay = EndDay - 1

    Workbooks.Open ThisWorkbook.Path & "\フォーマット格納フォルダ\請求書フォーマット.xlsm"
    
    Dim base As String: base = Workbooks("請求書フォーマット.xlsm").Name

   
    Dim List
    List = terget

    Dim Area2 'クライアントエリア
    Set Area2 = ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp)
    
    Dim Area
    Set Area = ThisWorkbook.Sheets(1).Range("B2", Area2)
    
    Dim Nwb
    Dim NwS As Worksheet

        For Each m In List
        Set Nwb = Workbooks.Add


        Workbooks(base).Sheets().Copy before:=Nwb.Sheets(1)

        
        Sheets(2).Delete
        Set NwS = Nwb.Sheets(1)
        Dim mnh As Date
        
        mnh = ThisWorkbook.Sheets(1).Range("a1")
        NwS.Range("H3") = Application.WorksheetFunction.EoMonth(mnh, 0)

            Dim a
            Dim b
            Dim z
            Dim f
            f = 16
            
            Set a = Area.Find(what:=m, LookIn:=xlValues)
            Set b = a
                     
               Do
               
               NwS.Cells(f, 3) = b.Offset(0, 1).Value  '品目
               NwS.Cells(f, 6) = b.Offset(0, 2).Value '金額
               NwS.Cells(f, 2) = b.Offset(0, 3).Value '個数
               NwS.Cells(f, 4) = b.Offset(0, 4).Value '備考
               
               Set b = Area.FindNext(b)

               f = f + 1
               
               Loop Until b.Address = a.Address
                        
            NwS.Range("c6") = m
            

  Call Savedate(m, mnh, NwS)
  Workbooks(Nwb.Name).Close
  Next
    Workbooks(base).Close
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    
    MsgBox "完成です"
    Unload UserForm1
  
End Sub

Function 非重複配列化()
    Dim LastRowCk
    LastRowCk = ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
    Dim Dic, i As Long, buf As String, Keys
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To LastRowCk  '範囲指定
        buf = ThisWorkbook.Sheets(1).Cells(i, 2).Value
        Dic.Add buf, buf
    Next i
    ''出力
    Keys = Dic.Keys
    For i = 0 To Dic.Count - 1
    Next i
    Set Dic = Nothing
    非重複配列化 = Keys
    On Error GoTo 0
End Function


Sub Savedate(m, mnh, NwS)
    Dim SaveF
    Dim SaveP, PDFp, PDFps
    SaveF = ThisWorkbook.Path & "\作成フォルダ\"
    SaveP = SaveF & "【" & m & "様" & "】" & Month(mnh) & "月度御請求書"
    NwS.SaveAs Filename:=SaveP
    Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=SaveP
End Sub

↓こちらはフォームモジュール

 Sub CommandButton1_Click()
    Dim terget()
    ReDim Preserve terget(ListBox1.ListCount - 1)
    Dim i, o
    i = 0
    o = 0
    
    If CheckBox1 = True Then
    For Each aaa In ListBox1.List
    terget(o) = aaa
    o = o + 1
    Next aaa
    
    Else
    For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    
    ReDim Preserve terget(o)
    terget(o) = ListBox1.List(i)
    o = o + 1
    End If
    
    Next i
    End If
    
    Call 新規請求書用ブック作成(terget)
    
End Sub
Private Sub UserForm_Initialize()
    ListBox1.List = 非重複配列化
    ListBox1.MultiSelect = fmMultiSelectMulti

End Sub