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

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

マクロ講座 動画編 38回
マクロ講座

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

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

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

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

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

  1. 今回の請求書の様式ですと、請求データが15件を超える場合には、2ページになります。
    そこでデータが15件以下の場合と15件以上の場合でコードを切り替えて印刷することにします。

    NAMAE1
  2. プログラムのコード前半部分(オートフィルタで抽出する迄)は、前回37回の内容と同じです。

    NAMAE2
  3. オートフィルターの条件を、 Range("対象月").Valueと、Range("得意").Valueのように、セルに名前をつけて指定しています。
    これにより、条件の切り替えがスムーズに行えます。

    NAMAE3
        With ws
            rng.AutoFilter Field:=1, Operator:=xlFilterValues, _
                Criteria2:=Array(1, Range("対象月").Value)
            rng.AutoFilter Field:=2, Criteria1:=.Range("得意").Value
  4. 次に抽出したデータを数えます。
    抽出データカウント()は関数にしてメインのコードから出しています。
    Countdata = 抽出データカウント()
    下は、請求書に不要な列を非表示にするコードです。
    .Columns("B:C").Hidden = True

    NAMAE4
  5. データ数をカウントしているので、データ数が15件以下の場合は、前回と同じコードで請求書にコピーしています。

    NAMAE5

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

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

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

    NAMAE7
    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
  3. 請求書が2枚の場合の印刷

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

    NAMAE8
                sh2.Range("A1:E15").Copy
                sh1.Range("A17").PasteSpecial Paste:=xlPasteValues
    
  4. つづいて、以下のコードで残りのデータをコピーして請求書の2枚目にはりつけます。

    NAMAE9
                sh2.Range("A16:E" & Countdata).Copy
                sh1.Range("A36").PasteSpecial Paste:=xlPasteValues
    
  5. 請求書の1枚目と2枚目に転記ができましたので、
    Call print2 マクロを呼び出します。
    これにより、2ページにわたる請求書がPDFとして印刷されます。

    NAMAE10
    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を見てみる

  1. 指定したフォルダにPDFが作成されました。

    NAMAE11
  2. こちらが1ページと2ページを表示したところです。

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

    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