文書や封筒（ラベル）などに、宛先を印刷することはたくさんあると思います。
そういったとき、多くの方はExcelで管理している宛名リストをWord文書に流し込んだり、宛名ラベルを作ったりされているのではないでしょうか。
しかし、その場合は差し込み作業や、ラベルを印刷して貼り付けるという作業が発生するなど、２度３度手間となってしまいますし、そういった時間ロスは積み重ねるほど大きくなってしまいます。
そこで、今回はひとつのExcelファイルで、宛先リストの管理と、文書や封筒への自動印刷ができるサンプルコードを紹介します。
このサンプルコードを利用すれば、宛名リストとして使っているExcelファイルに簡単に連続印刷の仕組みを導入できます。
また、そのまま使えるサンプルファイルもダウンロードできるようにしています。
サンプルファイルはとりあえず窓付き封筒用文書としてフォーマットを作成していますが、封筒用、ハガキ用など、好きに改変していただいてかまいません。
機能追加などもしやすいよう、実用上最低限のわかりやすいシンプルな構成にしています。
基本的な解説はこのページで一通りしていますので、仕組みだけでも見ていただくと改変などもしやすくなると思います。
連続印刷のイメージ
処理の概略と流れ
次の図は連続印刷の処理の概略をまとめたものです。
この例では、VBAが担当する部分と、関数が担当する部分があることに注目して見てください。
もちろんすべてVBAで処理することもできますが、一般的にメンテナンス性は関数のほうが高いので、適材適所で使い分けることをおすすめします。
処理の流れとしては次のとおりです。
- （VBA）データ件数の取得
- （VBA）F3セルにデータ№を入力
- （関数）F3セルをキーに表からデータを表示
- （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今度は具体的なコードを見ながら処理の流れをなぞってみましょう。
まず、LR = Range(“C3”).End(xlDown).Rowにより、C列でデータのある最終行、つまり「６」を取得します。
そして、最終行の「６」からヘッダー行数の「２」を差し引いた「４」という数値がデータ件数となり、これを「LR」という変数に格納します。
ここまでがデータ件数の取得です。
次に、For i = 1 To LRという部分ですが、ここではループ回数を設定しています。LRには先ほど取得したデータ件数の「４」が入っているため、１～４まで４回のループ処理を行う、という意味になります。
なお、「i」にはループの度に１から４まで、処理処理のたびに数字を格納します。
そして、For～Nextの中に挟んだコードに対して、この「i」を変化させながら回数分繰り返すことになります。
繰り返しの中で行う具体的な処理としては、
- F3セルへの処理№の入力 [ Range(“F3”) = i ]
- 印刷 [ PrintOut ]
の２点です。
イメージはこんな感じですが、わかりましたでしょうか。
割と省略しながらの説明なので、わからなかった方もいると思いますが、あきらめずに次のサンプルコードを見てください。
サンプルコード
掲載するサンプルコードは下図の「窓付き封筒に三つ折りにして入れる文書」をベースにしています。（このページでダウンロードできるサンプルファイルのフォーマットです。）
【前提】
- サンプルコードは次のイメージ図で動かすことを前提にしています。
- 文面シート（Sheet1）と、宛名シート（Sheet2）が分かれています。
- コード内のシートはすべてオブジェクト名（Sheet1・Sheet2）で指定しています。
【文面シート】
【宛名シート】
シンプル版
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このコードでは、C列に「○」のあるリストのみを処理対象にできます。
つまり、登録されているリストの中で、どのリストを印刷するのか選択して実行できます。
先のコードとの主な違いは次の２つです。
宛名リストの最終行を取得するコードについて、仮に宛名リストのC列に数式が入っていても見た目が空白セルであれば無視できます。例えばC列の「○」について、入力のある行だけ自動で表示させるような数式をC列に入力している場合でも正確に最終行を取得できます。
処理対象データの判定をIf Sheet2.Range(“C” & i) = “○” Thenで行っています。
つまり、宛名リストのC列に「○」がないリストは処理をスキップします。
中断コードの追加（印刷プレビュー用）
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こちらには処理中にESCキーを押すことで処理を正常に中断させるための中断コードを追加しています。
それ以外は先のコードと同じです。
中断コードの設置手順は次のとおりです。
モジュールの先頭に次のコードを設置
Declare PtrSafe Function GetAsyncKeyState Lib “User32.dll” (ByVal vKey As Long) As Long
※ プロシージャの外に設置してください。
For～Nextの中に次のコードを設置
If GetAsyncKeyState(vbKeyEscape) <> 0 Then
If MsgBox(“中断しますか？”, vbQuestion + vbYesNo) = vbYes Then Exit Sub
End If
※ For～Next内での処理が一通り終わったあたりに設置するのがおすすめです。
印刷（PrintOut）する場合はすぐにプリンターにデータが送信されてしまうのであまり意味がないですが、印刷プレビュー（PrintPreview）の際にはとても便利です。
大量のリストを連続で印刷プレビューするとき、このコードがなければすべて終わるまでプレビューを切り替え続けるか、ESCキー長押しなどで強制終了（エラー発生）させるしかなくなってしまいます。
それでは使い勝手が悪いので、印刷プレビューなどをするときは中断コードの設置を心掛けましょう。
サンプルファイルダウンロード
サンプルファイルはこちらからダウンロードできます。
お約束ですが、このファイルを利用したことによるいかなる損害にも責任は負えません。自己責任でお使いください。
なお、冒頭にも記載したとおり、このファイルはコードを読みやすくするため実用最低限の機能に絞ってできるだけシンプルにしています。いろいろ改変して遊んでみてください。
サンプルファイルのコード
最後に、サンプルファイルのコードを記載しておきます。
サンプルファイルを実際に動かしながら、どの部分でどの処理をしているか見るとわかりやすいと思います。
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今回は以上です。ありがとうございました。
コメント