HOME > 即効テクニック > Excel VBA > ページ設定関連のテクニック > 特定の列のデータが変わったら改ページして印刷する

特定の列のデータが変わったら改ページして印刷する|Excel VBA

ページ設定関連のテクニック

特定の列のデータが変わったら改ページして印刷する

(Excel 97/2000/2002/2003/2007/2010/2013/2016)

キーの値が変わったら改ページして印刷する方法をご紹介します。

サンプル1では、キーが変わるまでを印刷範囲とし、そのつど印刷プレビューを表示します。
ここでは、A列の先頭3文字をキーとしています。
キーをA列の値にしたり、A列とB列を結合した値にしたりする場合は、(1)と(2)を変更してください。

外側のDoループでは、キーの値が空白になるまで処理を繰り返します。
内側のDoループでは、キーの値が変わるまで1件ずつ読み込み、キーの値が変わったら印刷範囲を設定して、印刷プレビューを表示します。
(3)のPrintPreviewメソッドをPrintOutメソッドに変更すると、印刷プレビューを表示せずに直接印刷します。

●サンプル1●

Sub Sample1()
    Dim i As Long
    Dim StartRow As Long
    Dim CurrentKey As Variant
    Dim PreviousKey As Variant
    
    '1行目をタイトル行に設定
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    
    i = 2
    StartRow = i
    CurrentKey = Left(Cells(i, 1).Value, 3)   '---(1)
    
    'データが0件の場合は終了
    If Len(CurrentKey) = 0 Then Exit Sub

    'A列の値が空白になるまでループ
    Do
        '1件ずつキーを読み込む
        Do
            PreviousKey = CurrentKey
            i = i + 1
            CurrentKey = Left(Cells(i, 1).Value, 3)   '---(2)
        Loop Until CurrentKey <> PreviousKey

        'キーが変わったら印刷範囲を設定して印刷プレビューを表示
        ActiveSheet.PageSetup.PrintArea = _
                CStr(StartRow) & ":" & CStr(i - 1)
        ActiveSheet.PrintPreview   '---(3)
        StartRow = i
        
    Loop Until Len(CurrentKey) = 0

    '印刷範囲のクリア
    ActiveSheet.PageSetup.PrintArea = ""
End Sub

次のサンプル2は、キーが変わったときに改ページを挿入し、最後にまとめて印刷プレビューを表示します。キーの数(ページ数)が多い場合はこちらが便利でしょう。
ここでは、A列の値(Cells(i,1).Value)をキーとしています。

●サンプル2●

Sub Sample2()
    Dim i As Long
    Dim SaveKey As Variant
    
    
    'すべての改ページを削除
    ActiveSheet.ResetAllPageBreaks
    
    '1行目をタイトル行に設定
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    
    i = 2
    SaveKey = Cells(i, 1).Value
  
    'A列の値が空白になるまでループ
    Do Until Len(Cells(i, 1).Value) = 0
    
        'キーが変わったかどうかをチェック
        If SaveKey <> Cells(i, 1).Value Then
            '改ページを挿入
            ActiveSheet.HPageBreaks.Add Before:=Cells(i, 1)
            'キーを更新
            SaveKey = Cells(i, 1).Value
        End If
        i = i + 1
    Loop
    
    '印刷プレビューを表示
    ActiveSheet.PrintPreview
End Sub

サンプル2では印刷範囲を設定していないので、シート全体を印刷します。
A列の空白セルの後に何らかのデータがある場合、印刷範囲には含まれますが、空白セルの前に改ページは挿入されません。
空白セル以降を印刷したくないときは、PrintAreaプロパティを使用して印刷範囲を設定してください。