Excelでの自動ナンバリング後の印刷について

質問

自分がやりたい事はEｘｃｅｌでブックを開く度にナンバリングが自動生成され、都度印刷の度に部数に応じてその数が自動で加算されていくというようなものです。

過去の質問において下記のような回答を見つけました

Private Sub Workbook_Open()
Dim cnt As Long
Dim シート名, セル, 文字列 As String
シート名 = ActiveSheet.Name
セル = "B2" '←ナンバーを入れるセル（Range("C2")なら"C2"）…（１）
cnt = Len(Sheets(シート名).Range(セル))
If cnt = 0 Then
Sheets(シート名).Range(セル) = "No." & Format(InputBox("発行No.の初期値をセットしてください。"), "0000")
Else
文字列 = Right(Sheets(シート名).Range(セル), cnt - 3)
cnt = Val(文字列)
cnt = cnt + 1
Sheets(シート名).Range(セル) = "No." & Format(cnt, "0000") '←桁数をセット（５桁なら"00000"）…（２）
End If
End Sub

上記の記述は自分のやりたい事とほぼ一致しているのですが、この場合では複数枚印刷すると同じナンバリングの用紙がでてきてしまいます。

例えば、ブックを開いた際に自動生成された数がNo.0005だとして、10枚印刷した場合にNo.0005から連番で印刷され、次回ブックを開いた際にNo.0015から始まるといったような事です。

別シート等を使うような方法でも構わないので何か良い方法はありますでしょうか？

また不特定多数の人が出力した際に上書き保存をして終了しない人がいた場合等は上記の記述でのナンバリングは成立しませんが、そのような環境において通しでのナンバリングを成立させる方法はありますでしょうか？（Excel以外になったとしても）

解りにくいかもしれませんが、ご教授頂ければ幸いです。

回答No.1

keithin · ベストアンサー

準備：
印刷したいシートの番号を入れたいセル（仮にＢ２セル）に、セルの書式設定の表示形式のユーザー定義で
"No."0000
と設定しておき、とりあえず暫定的に数字の１を記入しておく

手順：
いまのWorkbook_Openマクロを消して、次のマクロに差し替える

private sub Workbook_BeforePrint(Cancel as boolean)
　dim c as variant
　dim i as long
　c = inputbox("HOW MANY COPY")
　if val(c) = 0 then exit sub
　cancel = true
　application.enableevents = false
　for i = 1 to c　
　with worksheets("印刷したいシート名")
　　.printout
　　.range("B2") = .range("B2") + 1
　end with
　thisworkbook.save
　next i
　application.enableevents = true
end sub

ブックを保存して開き直し、印刷する。

お礼

素晴らしい！！

まさに自分がやりたい事ができました。

本当にありがとうございます
m(__)m