VBAで自動印刷 ~Excel10等分のNo.カード~
Excelで10等分したNo.カード等を印刷する際に、
１、２ページ分くらいなら、良いのですが、
例えばNo.1～200など、大量に印刷するとなると、手動では大変ですよね？
そこで今回は、好きな「No.※※」から任意のNo.までを指定して、
自動でNo.を「入力＆印刷」をするVBAコードを作成しました。
「好きなNo.」～「好きなNo.」までを全て自動で印刷
今回の設定は以下になります。
・用紙サイズ：【A4】
・等分 ：10等分
例えば、
「１～１７」迄の番号を印刷したい
この場合には、
１枚目： １～１０
２枚目：１１～１７
このように印刷されるコードです。
宜しければ、試しに
１．ExcelファイルをDownLoad
２．ファイルを展開し、下部のサンプルコードをVBEへコピー貼付け
３．（忘れないうちに）印刷するプリンターを設定してください。
４．シート名：『枚数』に任意のNo.を入力し、VBA実行（印刷）
を試してみてください。
■ファイルは【Excelバージョン2016】で作成しております。
お使いのPCで、寸法が出ていれば良いのですが宜しければご参考に
■もしもうまく寸法が出ていなければ、以下の記事に
Excel10等分の方法をまとめましたので、宜しければ。
シート「印刷」はセル背景を真っ白に塗りつぶしてあります。
（【原型：左画像】 【UPしてあるファイル：右画像】）
↑にUpLoadしているExcelファイルは
A４サイズを10等分したものになります。（↑の画像をご参照ください）
今回はこれを活用してのサンプルコードをご紹介します。
★サンプルコード
Sub Print_Data()
'画面の更新停止
Application.ScreenUpdating = False
Dim StartNum, EndNum, i, j, k, cnt1, cnt2, cnt3 As Long
Dim A, B As String
Dim mySht1, mySht2 As Worksheet
Dim myRng As Range
A = "印刷"
B = "枚数"
Set mySht1 = ThisWorkbook.Worksheets(A)
Set mySht2 = ThisWorkbook.Worksheets(B)
Set myRng = mySht1.Range("A1")
'/////要記入箇所に記入がされていれば
If mySht2.Range("B2") <> "" And mySht2.Range("D2") <> "" Then
StartNum = mySht2.Range("B2") '始まりのNo.
EndNum = mySht2.Range("D2") '終わりのNo.
i = EndNum - StartNum + 1 '印刷するべきNo.の数
cnt1 = i \ 10 '10等分の場合、何ページあるか
cnt2 = i Mod 10 '10等分の場合、最後のページはNo.いくつまでか
'////もしも印刷が１ページ以上のボリュームならば
If cnt1 >= 1 Then
mySht1.Activate
'///ページ数(cnt1の商)だけ印刷を繰り返す
For j = 1 To cnt1
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = StartNum + (k - 1) + 10 * (j - 1)
Next k
For k = 6 To 10
myRng.Offset(2 * (k - 6), 2) = StartNum + (k - 1) + 10 * (j - 1)
Next k
mySht1.PrintOut
Next j
'ページ数(cnt1の商)だけ印刷を繰り返す///
'///最後のページ、端数が「０」でなければ
If cnt2 <> 0 Then
cnt3 = StartNum + 10 * cnt1
mySht1.Activate
mySht1.Cells.ClearContents
'//【最後のページ、端数を印刷】
'/端数が「５」以下の場合
If cnt2 <= 5 Then
For k = 1 To cnt2
myRng.Offset(2 * (k - 1), 0) = cnt3 + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「５」以下の場合/
'/端数が「６」以上の場合
If cnt2 >= 6 Then
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = cnt3 + (k - 1)
Next k
For k = 6 To cnt2
myRng.Offset(2 * (k - 6), 2) = cnt3 + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「６」以上の場合/
'【最後のページ、端数を印刷】//
End If
'最後のページ、端数が「０」でなければ///
End If
'もしも印刷が１ページ以上のボリュームならば////
'////もしも印刷が１ページ未満のボリュームならば
If cnt1 = 0 Then
mySht1.Activate
'///端数が「５」以下の場合
If cnt2 <= 5 Then
For k = 1 To cnt2
myRng.Offset(2 * (k - 1), 0) = StartNum + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「５」以下の場合///
'///端数が「６」以上の場合
If cnt2 >= 6 Then
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = StartNum + (k - 1)
Next k
For k = 6 To cnt2
myRng.Offset(2 * (k - 6), 2) = StartNum + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「６」以上の場合///
End If
'もしも印刷が１ページ未満のボリュームならば////
'内容をクリア(初期化)
mySht1.Activate
mySht1.Cells.ClearContents
End If
'要記入箇所に記入がされていれば/////
mySht2.Activate
'画面の更新再開
Application.ScreenUpdating = True
End Sub
上記コードは注記と共に記載してありますので、
「ここの部分ではどんな処理がされているのか？」が分かるようになっている
・・・と思いたいです(笑)
少々長いですが、このコードをVBEにコピー＆貼付けして
任意のNo.を「シート名：枚数」のセル【B2】と【D2】に記入して
コードを実行して頂ければ、自動で印刷されます。
一気に大量に印刷するとミスした場合に怖いので、
出来れば少ない枚数でテストしてもらう事をオススメいたします。
【おまけ】サンプルコード
下記のサンプルコードは
数字の前に任意の文字列を挿入する事が出来るコード
です。具体的には以下のように
数字の前に「No.」を添える事が出来ます。
「１」→「No.1」
下記のサンプルコードでは数字の前に文字列を挿入しておりますが、
数字の後方に文字列を挿入する事ももちろん可能です。
※例えば「１」→「１巻」など
◆挿入する文字列を変更するには
C = “No. “ → C = “[好きな文字列]”
に変更してください。
◆数字の後方に文字列を挿入するには
「C ＆」で始まっている箇所を全て「 ＆ C」で終わるようにする
例：
「C & cnt3 + (k – 1)」→「cnt3 + (k – 1) & C」とする
Sub Print_Data2()
'画面の更新停止
Application.ScreenUpdating = False
Dim StartNum, EndNum, i, j, k, cnt1, cnt2, cnt3 As Long
Dim A, B, C As String
Dim mySht1, mySht2 As Worksheet
Dim myRng As Range
A = "印刷"
B = "枚数"
C = "No. "
Set mySht1 = ThisWorkbook.Worksheets(A)
Set mySht2 = ThisWorkbook.Worksheets(B)
Set myRng = mySht1.Range("A1")
'/////要記入箇所に記入がされていれば
If mySht2.Range("B2") <> "" And mySht2.Range("D2") <> "" Then
StartNum = mySht2.Range("B2") '始まりのNo.
EndNum = mySht2.Range("D2") '終わりのNo.
i = EndNum - StartNum + 1 '印刷するべきNo.の数
cnt1 = i \ 10 '10等分の場合、何ページあるか
cnt2 = i Mod 10 '10等分の場合、最後のページはNo.いくつまでか
'////もしも印刷が１ページ以上のボリュームならば
If cnt1 >= 1 Then
mySht1.Activate
'///ページ数(cnt1の商)だけ印刷を繰り返す
For j = 1 To cnt1
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = C & StartNum + (k - 1) + 10 * (j - 1)
Next k
For k = 6 To 10
myRng.Offset(2 * (k - 6), 2) = C & StartNum + (k - 1) + 10 * (j - 1)
Next k
mySht1.PrintOut
Next j
'ページ数(cnt1の商)だけ印刷を繰り返す///
'///最後のページ、端数が「０」でなければ
If cnt2 <> 0 Then
cnt3 = StartNum + 10 * cnt1
mySht1.Activate
mySht1.Cells.ClearContents
'//【最後のページ、端数を印刷】
'/端数が「５」以下の場合
If cnt2 <= 5 Then
For k = 1 To cnt2
myRng.Offset(2 * (k - 1), 0) = C & cnt3 + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「５」以下の場合/
'/端数が「６」以上の場合
If cnt2 >= 6 Then
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = C & cnt3 + (k - 1)
Next k
For k = 6 To cnt2
myRng.Offset(2 * (k - 6), 2) = C & cnt3 + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「６」以上の場合/
'【最後のページ、端数を印刷】//
End If
'最後のページ、端数が「０」でなければ///
End If
'もしも印刷が１ページ以上のボリュームならば////
'////もしも印刷が１ページ未満のボリュームならば
If cnt1 = 0 Then
mySht1.Activate
'///端数が「５」以下の場合
If cnt2 <= 5 Then
For k = 1 To cnt2
myRng.Offset(2 * (k - 1), 0) = C & StartNum + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「５」以下の場合///
'///端数が「６」以上の場合
If cnt2 >= 6 Then
For k = 1 To 5
myRng.Offset(2 * (k - 1), 0) = C & StartNum + (k - 1)
Next k
For k = 6 To cnt2
myRng.Offset(2 * (k - 6), 2) = C & StartNum + (k - 1)
Next k
mySht1.PrintOut
End If
'端数が「６」以上の場合///
End If
'もしも印刷が１ページ未満のボリュームならば////
'内容をクリア(初期化)
mySht1.Activate
mySht1.Cells.ClearContents
End If
'要記入箇所に記入がされていれば/////
mySht2.Activate
'画面の更新再開
Application.ScreenUpdating = True
End Sub
以上になります。
日常業務のお役に立てれば幸いです。