こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBA 連番印刷

昨日以下の質問をさせていただいた者です。

http://okwave.jp/qa/q8349562.html
こちらで教えていただいた以下のコードに、
J2のセルに連番を振るコードを付け足したいと思い、
同じくこちらのサイトの過去の履歴にあった以下コードを参考にとやってみているのですが、
Next で指定された変数の参照が無効です。と言われてしまいます…

印刷部数の指定はいらず、sheet印刷のJ2セルに1から始まる連番を振りたいのです。

どのように修正をしたらいいのかご教示願います。


Sub Sample4()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("B6") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
'Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub

連番印刷のコード

Sub NumberPrint()
Dim idx As Integer
Dim res
 res = Application.InputBox("印刷部数を入力してください", Type:=1)
 If res > 0 Then
  For idx = 1 To res
   Range("AW3").Value = idx
   ActiveSheet.PrintOut
  Next idx
 End If
End Sub

投稿日時 - 2013-11-17 15:09:13

QNo.8350951

すぐに回答ほしいです

質問者が選んだベストアンサー

No.1です。

印刷枚数の連番をご希望だった!というコトですね。
VPageBreakオブジェクトなどを利用して、改ページの回数を参考にしてみたのですが、

結局1からの連番ではなく、そのSheetの総ページ数しか表示できないようです。

ただ、これでは何もお役に立てないので、苦肉の策として、ヘッダーで対応してはダメですか?

ヘッダーの編集で &[ページ番号]/&[総ページ数]
とすれば、とりあえずは 各項目ごとの総ページ数に対する何ページ目か?は表示できると思います。

全部のページ枚数は表示できませんが、この程度しか思いつきません。
ごめんなさいね。m(_ _)m

投稿日時 - 2013-11-17 23:58:04

お礼

いえいえ、度々助けていただいて感謝です。
ありがとうございます。
はじめヘッダーでやったんですが、
やはり印刷枚数で出したくて…
でもこれで本当に十分満足です!
ありがとうございました!

投稿日時 - 2013-11-18 07:17:24

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

こんばんは!
前回回答した者です。

>sheet印刷のJ2セルに1から始まる連番を振りたいのです。

J2セルに連番というコトはいくら行数が多くて何ページになっても1度しか印刷されないので
前回の質問だと「200」の場合に「1」・「300」の場合に「2」・・・
という感じの連番になればよいのですよね?
(印刷枚数ではない!という解釈)

そうであれば単純に1行だけ追加すれば大丈夫だと思います。
前回のコードの○行と△行の間!といっても行数が多いので、もう一度コードを載せてみます。
(★マークのところを追加しただけです)

Sub Sample5()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("J2") = i - 1 '←★この行のみ追加★
wS2.Range("B6") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub

こんな感じではどうでしょうか?m(_ _)m

投稿日時 - 2013-11-17 21:30:46

補足

tom04さま、こんばんは!
昨日に引き続きありがとうございます。
印刷したものを配布回収するので回収の際の漏れチェックに、
と思い連番を振りたかったので、=印刷枚数で教えていただきたいです。
自分でやってみたのですが全て「1」になってしまい、
途方に暮れています…

また本日セル番地と転記後の値をクリア(書式はそのまま)のコードを追加し以下のようになっております。

遅い時間に申し訳ありませんが、
明日提出しなければならなくて焦っております。

どうかよろしくお願いいたします。

Sub Sample4()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("J2") = i - 1 '←★この行のみ追加★
wS2.Range("B2") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row

Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut

Range("B4:J503").ClearContents


Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub

投稿日時 - 2013-11-17 22:00:40

あなたにオススメの質問