印刷時に自動で連番を振りたい（1頁に2か所）

質問

Excel2013使用です。

※私はマクロの記録は出来ますが、VBAに関しては無知です。

【質問内容】

A4用紙に帳票を2枚作っています。（同じ物）
印刷時、帳票に連番を自動で振りたいです。
連番を振りたいセルは「D1」と「D16」です。

つまり、1枚目の紙には「1」「2」
　　　　　2枚目の紙には「3」「4」

…と印刷されるようにしたいです。
（因みに、最後のページ数は都度変わります）

ネットで見つけたVBAを利用して

Sub Sample()
Dim i As Long, myCnt As Long
myCnt = Application.InputBox("印刷部数は?")
On Error Resume Next
Select Case myCnt
Case False
MsgBox "キャンセルされました"
Case Else
For i = 1 To myCnt * 2 Step 2
Range("D1") = i
Range("D16") = i + 1
ActiveSheet.PrintPreview '<<--プレビュー画面が不要ならこの行を削除。
'ActiveSheet.PrintOut '<<--直接印刷するなら「'」を消去。
Next i
End Select
End Sub

を実行してみましたが、上手く行きません。
（出てきたウィンドウに部数を入力しても、その通り印刷されません。
例えば「2部」と入力して、印刷画面のプロパティでは部数を指定せずに
印刷すると、最初の1頁だけが印刷されます。
試に印刷画面で2部にすると、今度は同じ紙（連番1と2）が2部印刷される
だけです）

どこを改良したらよいでしょうか…？

回答No.4

watabe007 · ベストアンサー

>１回１回印刷ボタンを押さないといけないんですね。
まさか
ActiveSheet.PrintPreview '<<--プレビュー画面が不要ならこの行を削除。
'ActiveSheet.PrintOut '<<--直接印刷するなら「'」を消去。
このままですか？
'ActiveSheet.PrintPreview '<<--プレビュー画面が不要ならこの行を削除。
ActiveSheet.PrintOut '<<--直接印刷するなら「'」を消去。
に変えてください。

お礼

その「まさか」でした…。
言われてみれば、ごもっともですm(_ _)m

無事解決しました。
今日中にしなければいけなかったので、とても助かりました！
ありがとうございました！！

回答No.3

kkkkkm

> 出てきたウィンドウに部数を入力しても

ということですが、通常はなにも出ずにそのまま印刷されます。
で、質問に記載されたコードでangelnavi さんの希望通りに
1枚目の紙には「1」「2」
2枚目の紙には「3」「4」
と記載されたものが印刷されます。

プリンタの設定でなにかウィンドウが出るような設定「プレビューを表示する」とかがされていないでしょうか。

Application.InputBox("印刷部数は?")
は
Application.InputBox("印刷部数は?", Type:=1)
入力を数値型に指定しておいた方がいいと思います。

補足

kkkkkmさん、いつもありがとうございます。

＞通常はなにも出ずにそのまま印刷されます

…とのことですが、ウィンドウは出てきます。よく分かりませんが
「Application.InputBox("印刷部数は?")」
が、そういうウィンドウを出す指示なのではないでしょうか？

そのウィンドウで部数を入力して「OK」を押すのですが、それだけでは
印刷されないので、手動で印刷ボタンを押しています。

すると、通常通り印刷のプロパティ画面が出て来るので、そこで印刷
ボタンを押すと印刷されます。

あとは先述の通りで、印刷画面で「印刷」ボタンを押した回数だけ印刷
されるというのが現状です。

それでも一応目的は達せられるのですが、100回押すのはちょっと面倒
なので質問させて頂きました。

回答No.2

watabe007

>つまり、1枚目の紙には「1」「2」
> 　　　　　2枚目の紙には「3」「4」
では
Sub Sample()
Dim i As Long, myCnt As Long, j As Long
myCnt = Application.InputBox("印刷部数は?")
On Error Resume Next
Select Case myCnt
Case False
MsgBox "キャンセルされました"
Case Else
For i = 1 To myCnt
j = i * 2 - 1
Range("D1").Value = j
Range("D16").Value = j + 1
ActiveSheet.PrintPreview '<<--プレビュー画面が不要ならこの行を削除。
'ActiveSheet.PrintOut '<<--直接印刷するなら「'」を消去。
Next i
End Select
End Sub

補足

ありがとうございます！

教えて頂いたコードでも質問前と同じ結果になってしまったのですが、
そこで自分の印刷の仕方が間違っていることに気が付きました。

「印刷部数は？」のウィンドウで部数を入力するので、てっきり印刷
ボタンを１回押したらその部数までずらっと自動で出て来ると思って
いましたが、１回１回印刷ボタンを押さないといけないんですね。
（紙4枚分印刷したい場合は4回押す）

その方法でやったら上手く行きました。
ありがとうございます。

因みに、今回は200番まで（つまりA4紙100枚分）印刷するのですが、
1回1回印刷ボタンを押さずに済む方法がもしあったら教えて頂けますか？

回答No.1

imogasi

Ｄ１＝１、Ｄ１６＝２で、range("A1:E30")のPrintOutを発行すると１，２で１枚印刷されます。
そこでＤ１，Ｄ１６を希望の値にして（Ｄ１＝３、Ｄ１６＝４）
range("A1:E30")のPrintOutを発行すると、３，４で１枚印刷されます。
Ｄ１６が必要番号になるまでＦｏｒＮｅｘｔででも、印刷すればしまいのように思うが、勘違いかな？
２枚分のセル範囲を使って印刷できる方法。
印刷物の実質内容がバラバラだとそうはいかない。
その場合はＤ１，Ｄ１６に相当するセルに適当な数をセットしておく必要がある。
ーー
エクセルにはＢｅｆｏｒｅＰｒｉｎｔイベントはあっても、ＢｅｆｏｒｅＰａｇｅＰｒｉｎｔに当たるイベントは無いようなので、１枚印刷したつど、セルに番号設定のため、プログラムで介入をすることはできないと思う．もしこれができれば、２枚分のセル範囲で印刷できる。
ーー
シートの下行の方に、３，４以下のセル範囲を作って（プログラムでできる）、白紙じゃなく内容があるなら、第1枚目部分をコピーしておいて、改ページブレークをいれ、シートの全データ範囲を指定して印刷するのも、できそうだが、スマートではないと思う。
連続したｎ枚分のセル範囲を使う。