VBA転記 帳票2枚を1枚に収める方法

Question

今まで仕事で手書きでエクセルシートで作成した帳票に詳細を書き込んでいたのですが、エクセルデータに入力した1行分を帳票1枚ずつに転記して帳票をPDF化したいと考えています。

帳票がA5サイズでA4サイズのプリントアウトをするとなると帳票2枚組になるのでそれらの帳票を一つのPDFファイルにしたいのですが、

案（１）エクセルシートを最初から帳票２枚組にしてエクセルデータの一行一行をループで帳票へ転記する
案（２）帳票は1枚ずつにしてPDF化するときに2枚組になるように設定する

のいずれかの案で考えているのですが、個人的には案（１）の方がやりやすいのかなと考えています。

その際、エクセルデータのデータから2枚目以降の帳票にループでエクセルデータを転記する方法（同じエクセルデータから1枚目の帳票に転記するコードと同じエクセルシートにある2枚目の帳票に転記するコードがバッティング？するのではと思い書き方に悩んでいます）と帳票を1つのPDFファイルに収める方法を教えていただけますと有難いです。

他にやりやすい方法がありましたらご教示のほどを宜しくお願い致します。

Comments

[coco_bauer]

とにかく、作りかけのプログラムを質問に追加してください。
質問の文章だけでは、どんなことがしたいのか、何が問題なのか、といった事が読み取れません。

Answer 1

こんにちは。よろしくおねがいいたします。
理解が間違っていたらごめんなさい。　私が理解しましたのは・・
以下のような”請求データ”シートがあって

これを、以下のような「２段式」の請求書に転記して、個々にPDFで保存する、ということでよろしいですか？

これで考えましたのが、以下のようなコードです。

Option Explicit

Sub CreateSeikyusho()

Dim SeikyuDataSheet As Worksheet
Set SeikyuDataSheet = ThisWorkbook.Worksheets("請求データ")
Dim TemplateSheet As Worksheet
Set TemplateSheet = ThisWorkbook.Worksheets("請求書テンプレート")

Dim r As Range
Dim i As Long
Dim PDFFileName As String

For i = 2 To SeikyuDataSheet.Cells(Rows.Count, 1).End(xlUp).Row Step 2

With SeikyuDataSheet
 '上段の請求書
 TemplateSheet.Range("F4") = .Cells(i, 1).Value '請求書番号
 TemplateSheet.Range("C6") = .Cells(i, 2).Value '請求先
 TemplateSheet.Range("E8") = .Cells(i, 3).Value '請求金額

 '下段の請求書
 TemplateSheet.Range("F15") = .Cells(i + 1, 1).Value '請求書番号
 TemplateSheet.Range("C17") = .Cells(i + 1, 2).Value '請求先
 TemplateSheet.Range("E19") = .Cells(i + 1, 3).Value '請求金額

'PDFのファイル名が重複しないように、とりあえず請求先名をファイル名にしました。
 PDFFileName = "請求書" & .Cells(i, 2).Value & "-" & .Cells(i + 1, 2).Value & ".pdf"
End With

TemplateSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFileName

Next I

End Sub

これで生成されるPDFが、以下のようなイメージです。

特段むずかしいことはしていません。”請求データ”シートから読みこむとき、２行をひとかたまりで読んでいるだけです。（なので for nextの部分が step 2にしています）

請求データが奇数のときは、下段の請求書は空白になってしまいますが。。それはしゃあないですね（苦笑）

Answer 2

![]

↑の表で、1列目に印を付けた行だけ、
テンプレートに転記してPDF化するマクロです。

仕事で個人で使うため用に作ったもの(ほぼ使い捨てるくらいの気持ちのもの)で、
誰に使ってもらうでもなく、見せる予定でもなかったので、
メッチャ雑に作ってます。＾＾；；
参考になれば。。。＾＾；

あ、1案で、2行づつ処理するように（偶数行はIF文で処理を飛ばすように）
改造したらいいかと思います。

Option Explicit

Sub test()
    Dim Rng As Range
    Dim r As Range

    With Worksheets("一覧").Range("A1").CurrentRegion
        Set Rng = Intersect(.Cells, .Offset(1), .Columns(1).SpecialCells(xlCellTypeConstants).EntireRow)
    End With
    Worksheets(Array("申請書", "申請区間")).Select

    For Each r In Rng.Rows
        With Worksheets("申請書")
            Application.StatusBar = r.Cells(2).Value & "を出力中..."
            .Range("K15").Value = r.Cells(3).Value
            .Range("K17").Value = r.Cells(2).Value
            .Range("E19").Value = r.Cells(4).Value
            .Range("N19").Value = r.Cells(5).Value
            Macro1 .Range("N19").Value
        End With
    Next
    Application.StatusBar = False
End Sub

Sub Macro1(ByVal sName As String)
    Dim sPath As String

    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    On Error GoTo ErrH
    
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sPath & "\" & sName & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    On Error GoTo 0
    Exit Sub
            
ErrH:
    Application.Wait [Now() + "0:00:00.5"]
    Resume
End Sub

参考になれば。。。

あぁ、見直したら、
For Each r In Rng.Rows
はまずいですね。
まぁ、自分用なら、
不具合がちょいちょいあっても文句言いようがないので、
不便でも対応していくしかないですね＾＾；
気付いたときに改良していく感じだけど、暇がないとなかなか難しいですね＾＾；
暇があればもうちょい真面目に作りたいのですが＾＾；

Answer 3

一枚目の帳票出力のコードが書けたら、２枚目は出力開始セルをずらせばいいだけだと思います。
まずは、一枚目の帳票出力のコードを書いてみてはどうですか。
それで、その先が分からなければ、書いたコードを提示して、どの部分が分からないかピンポイントで質問するといいと思います。