【VBA】宛名リストを文書や封筒に連続印刷する方法（サンプルコード＆ファイル）

Sub 連続印刷_イメージ()

    '最終行(データ数)取得
    Dim LR As Long
    LR = Range("C3").End(xlDown).Row - 2 '最終行からヘッダー行の2行分を引く

    '連続印刷
    Dim i As Long
    For i = 1 To LR
        Range("F3") = i 'F3セルの数値を切り替え
        PrintOut        '印刷処理
    Next i

End Sub

Sub 連続印刷_サンプル1()

    '最終行(データ数)取得
    Dim LR As Long
    LR = Sheet2.Range("D3").End(xlDown).Row - 2

    '連続印刷
    Dim i As Long
    For i = 1 To LR
        Sheet1.Range("BD2") = i
        Sheet1.PrintOut '印刷
    Next i

End Sub

Sub 連続印刷_サンプル2()

    '宛名リストの最終行取得
    Dim LR As Long
    For LR = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
        If Sheet2.Cells(LR, "C") <> "" Then Exit For
    Next LR

    '連続印刷
    Dim i As Long
    For i = 1 To LR - 2 'ヘッダー行数を引く
        '宛先リストのC列が○の行のみ処理対象
        If Sheet2.Range("C" & i) = "○" Then
            Sheet1.Range("BD2") = Sheet2.Range("B" & i)
            Sheet1.PrintOut '印刷
        End If
    Next i
    
End Sub

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub 連続印刷_サンプル3()

    '宛名リストの最終行取得
    Dim LR As Long
    For LR = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
        If Sheet2.Cells(LR, "C") <> "" Then Exit For
    Next LR

    '連続印刷
    Dim i As Long
    For i = 1 To LR - 2 'ヘッダー行数を引く
        '宛先リストのC列が○の行のみ処理対象
        If Sheet2.Range("C" & i) = "○" Then
            Sheet1.Range("BD2") = Sheet2.Range("B" & i)
            Sheet1.PrintPreview '印刷プレビュー(確認用)
        End If
        
        '中断コード(ESCキーで中断)
        If GetAsyncKeyState(vbKeyEscape) <> 0 Then
            If MsgBox("中断しますか？", vbQuestion + vbYesNo) = vbYes Then Exit Sub
        End If
    Next i

End Sub

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub 連続印刷_実用版()

    '実行確認
    If MsgBox(Sheet1.Range("BF2") & "を開始してもよろしいですか？" & vbCrLf & vbCrLf & _
              "≪注　意≫" & vbCrLf & "処理を中断するときはESCキーを押してください。", vbQuestion + vbYesNo) = vbNo Then
        MsgBox "中止しました。", vbInformation
        Exit Sub
    End If
    
    '画面更新をオフ
    Application.ScreenUpdating = False
    
        '宛先シートを選択
        Sheet2.Select
    
        '各種処理開始
        With Sheet2
            '宛名リストの最終行取得
            On Error Resume Next
            Dim LR As Long
            For LR = Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
                If Cells(LR, "C") <> "" Then Exit For
            Next LR
            
            '印刷または印刷プレビュー
            Dim i As Long
            For i = 1 To LR - 2 'ヘッダー行数を引く
                '宛先リストのC列が○の行のみ処理対象
                If Sheet2.Range("C" & i) = "○" Then
                    Sheet1.Range("BD2") = Sheet2.Range("B" & i)
                    '処理選択によって印刷・印刷プレビューを切替
                    If Sheet1.Range("BF2") = "印刷" Then
                        Sheet1.PrintOut '印刷
                    Else
                        Sheet1.PrintPreview '印刷プレビュー(確認用)
                    End If
                End If
                
                '中断コード(ESCキーで中断)
                If GetAsyncKeyState(vbKeyEscape) <> 0 Then
                    If MsgBox("中断しますか？", vbQuestion + vbYesNo) = vbYes Then Exit Sub
                End If
            Next i
        End With
    
        '文面シートに戻る
        Sheet1.Activate

    '画面更新をオン
    Application.ScreenUpdating = True

    '終了メッセージ
    MsgBox "印刷が終了しました。", vbInformation

End Sub