Excelだけで「差し込み印刷」できるマクロを作ります

仕事で、Word+Excelの差し込み印刷を聞かれたのですが、手順が多すぎて、なんとかしたいなと思い、作成した備忘録です。
ついでに、年賀はがきの表書きを作ってみました。

検索すると色々見つかります

https://mokomokomomoko.com/excel_macro_print/
様式だけお借りします。

これが良かった

http://engi-seishi.la.coocan.jp/excel_sample.htm#etc
の　Excel宛名シール印刷（ヨコ3面タテ7面=21面タックシール用のみ）

これを改造してみます。(作者様、無断でごめんなさい）

印刷　する/しない　列を追加、敬称も追加

printSheetをマクロで直接貼り付けしていたのを、このシートへ貼り付けに変更
このシートのタイトル列と行数分だけコピーして、印刷動作へ、これをdataシートの最後まで繰り返す
例えば、１シート４枚なら、４行にして、printSheetの様式変更に対応

印刷用シート、printDataシートにたいして式　例：=PrintData!E2　でデータを転記
なので、同じものを４件印刷する場合は、printSheetで対応可能

マクロの中で使っている名前の定義はこの２件

マクロ

備忘録です。これで全部

Module1

Option Explicit

Sub 宛名シール印刷()
    Dim cHead As Integer    ' printDataテーブルの列数
    Dim cRows As Integer    ' printDataテーブルの行数
    cHead = Worksheets("printData").Range("TBL_printData").ListObject.HeaderRowRange.Count
    cRows = Worksheets("printData").Range("TBL_printData").ListObject.ListRows.Count

    Dim iData As Long       ' data処理行
    Dim iPData As Long      ' printData処理行
    Dim jPData As Long      ' printData処理列
    Dim rngData As Range    ' dataのrange
    Dim rngPData As Range   ' printDataのrange

    printDataClear          'sheet[printData]の名前[TBL_printData]範囲をクリア

    iData = 0
    iPData = 0
    Set rngData = Worksheets("data").Range("A5")       '処理開始位置
    Set rngPData = Worksheets("printData").Range("B1") '処理開始位置

    Do Until rngData.Offset(iData, 0).Value = ""
        If rngData.Offset(iData, 0).Value = "する" Then
            iPData = iPData + 1
            For jPData = 1 To cHead
                rngPData.Offset(iPData, jPData - 1) = rngData.Offset(iData, jPData - 1)
            Next
            If iPData > (cRows - 1) Then
                実印刷
                printDataClear   'sheet[printData]の名前[TBL_printData]範囲をクリア
                iPData = 0
                Worksheets("data").Select
            End If
        End If
        iData = iData + 1
    Loop
    If iPData > 0 Then 実印刷
End Sub

' 宛先シール実印刷
Sub 実印刷()
    Sheets("printSheet").Select
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0#)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Zoom = 98
    End With

    Range("Print_Area").Select

    Select Case MsgBox(prompt:="印刷を続けますか？" & vbCrLf & "いいえ：プレビュー", Buttons:=vbYesNoCancel)
        Case vbYes
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Case vbNo
            ActiveWindow.SelectedSheets.PrintPreview
        Case Else
            Worksheets("data").Select
            End
    End Select
    Worksheets("data").Select
End Sub

'sheet[printData]の名前[printData]範囲をクリア
Sub printDataClear()
    Worksheets("printData").Range("TBL_printData").ClearContents
End Sub