複数ページの請求書へ書き出しはどうやるか？売上データから、PDFへの請求書印刷

マクロ講座動画編 38回

動画でExcel　複数ページの請求書へ書き出しはどうやるか？売上データから、PDFへの請求書印刷

複数ページの請求書へ書き出しはどうやるか？売上データから、PDFへの請求書印刷

前回の動画で売上データを月別顧客別に抽出しましたが、それを請求書に転記するという段階になりました。
一枚の請求書に収まればいいのですけれども、中には一枚では収まらないケースもあります。
そういった時はどうしたらいいのかということで、2通りのケースを考えていきます。

マクロ動画　複数ページの請求書へ書き出しはどうやるか？売上データから、PDFへの請求書印刷

複数ページにわたる請求書を発行

今回の請求書の様式ですと、請求データが15件を超える場合には、2ページになります。
そこでデータが15件以下の場合と15件以上の場合でコードを切り替えて印刷することにします。
プログラムのコード前半部分（オートフィルタで抽出する迄）は、前回37回の内容と同じです。
オートフィルターの条件を、 Range("対象月").Valueと、Range("得意").Valueのように、セルに名前をつけて指定しています。
これにより、条件の切り替えがスムーズに行えます。
```
    With ws
        rng.AutoFilter Field:=1, Operator:=xlFilterValues, _
            Criteria2:=Array(1, Range("対象月").Value)
        rng.AutoFilter Field:=2, Criteria1:=.Range("得意").Value
```
次に抽出したデータを数えます。
抽出データカウント()は関数にしてメインのコードから出しています。
Countdata = 抽出データカウント()
下は、請求書に不要な列を非表示にするコードです。
.Columns("B:C").Hidden = True
データ数をカウントしているので、データ数が15件以下の場合は、前回と同じコードで請求書にコピーしています。

請求書が1枚の場合の印刷

請求書1枚の場合の転記ができたら、
Call print1　と print1マクロを呼び出します。

請求書1枚用のコードは、データの転記について記述してあります。

Sub print1()
    sh_seikyuu.Activate
    Set Prng = sh_seikyuu.Range(Cells(1, 1), Cells(31, 5))
    Dim tuki As String
    tuki = WorksheetFunction.Text(Range("対象月"), "yyyy年mm月")
    Prng.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ActiveWorkbook.Path & "\" & "請求書印刷" & "\" & _
            Range("得意") & tuki & ".pdf"
End Sub

請求書が2枚の場合の印刷

データが15件以上の場合には、作業用のブックを作成してそこに転記することにします。今回は配列やディクショナリーを使わないためです。
データを作業用ブックにコピーして貼り付けます。そして、A1：E15までをコピーして、それをまず請求書の1枚目にはりつけます。
```
            sh2.Range("A1:E15").Copy
            sh1.Range("A17").PasteSpecial Paste:=xlPasteValues
```

つづいて、以下のコードで残りのデータをコピーして請求書の2枚目にはりつけます。

            sh2.Range("A16:E" & Countdata).Copy
            sh1.Range("A36").PasteSpecial Paste:=xlPasteValues

請求書の1枚目と2枚目に転記ができましたので、
Call print2　マクロを呼び出します。
これにより、2ページにわたる請求書がPDFとして印刷されます。

Sub print2()
    sh_seikyuu.Activate
    Set Prng = sh_seikyuu.Range(Cells(1, 1), Cells(66, 5))
    Dim tuki As String
    tuki = WorksheetFunction.Text(Range("対象月"), "yyyy年mm月")
    Prng.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ActiveWorkbook.Path & "\" & "請求書印刷" & "\" & _
            Range("得意") & tuki & ".pdf"
End Sub

印刷された2ページの請求書PDFを見てみる

指定したフォルダにPDFが作成されました。
こちらが1ページと2ページを表示したところです。

作業用のブックについては、今回は削除してしまいます。
次回では、 請求書を送るお得意先を重複しないデータとして抽出して繰り返し処理をおこなっていきます。
またその記録として作業ブックではなく、請求書の発行記録として保存することにしましょう。

Option Explicit
Dim ws As Worksheet, sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, Countdata As Long, Prng As Range
   
Sub 複数ページ請求書作成()
    Set ws = sh_uriage
    Set sh1 = sh_seikyuu
    Set rng = ws.Range("A5").CurrentRegion
    sh1.Activate
    Union(sh1.Range("A17:E31"), Range("A36:E65")).ClearContents
    ws.Activate
    Application.ScreenUpdating = False
    With ws
        rng.AutoFilter Field:=1, Operator:=xlFilterValues, _
            Criteria2:=Array(1, Range("対象月").Value)
        rng.AutoFilter Field:=2, Criteria1:=.Range("得意").Value
        Countdata = 抽出データカウント()
        .Columns("B:C").Hidden = True
        If Countdata <= 15 Then
            .Range("A5").CurrentRegion.Resize(rng.Rows.Count - 1). _
                Offset(1, 0).Copy
            sh1.Range("A17").PasteSpecial Paste:=xlPasteValues
            sh1.Range("A4").Value = ws.Range("得意").Value

            Call print1
        Else
            Dim newbk As Workbook
            Set newbk = Workbooks.Add
            Dim newfile As String
            newfile = "作業用.xlsx"
            newbk.SaveAs Filename:=ThisWorkbook.Path _
                        & "\" & "請求書印刷" & "\" & newfile

            Set sh2 = newbk.ActiveSheet
            ActiveWindow.WindowState = xlMinimized
            .Range("A5").CurrentRegion.Resize(rng.Rows.Count - 1). _
                Offset(1, 0).Copy
            sh2.Range("A1").PasteSpecial Paste:=xlPasteValues
            sh2.Range("A1:E15").Copy
            sh1.Range("A17").PasteSpecial Paste:=xlPasteValues
            sh2.Range("A16:E" & Countdata).Copy
            sh1.Range("A36").PasteSpecial Paste:=xlPasteValues
            Call print2
        End If
        .Columns("B:C").Hidden = False
    End With
    Application.ScreenUpdating = True
    sh_seikyuu.Activate
    ThisWorkbook.Save
End Sub