すみません。印刷マクロをもう一度

質問

以前印刷マクロを教えていただいたのですが、もう一度お助けください

シートに下のようなデータベースがあります。
　受付番号　氏名　〒　住所・・・・・印刷日（T列）
　１００１
　１００２
　１００３
　１００４
　　　・
　　　・
　　　・　　
印刷時に受付番号を入力することで印刷できるものです。
１回印刷したデ－タは次回は印刷範囲外で判断基準を印刷日とし印刷を実行した日に自動的に日付が印刷日に入力されるものをです。
たとえば、最初に受付１０５４までを印刷、次は受付１１３６までを印刷と印刷件数は不変であり、最初の時に１０５４までの印刷日に全て日付が入力、次は１１３６までの全ての印刷日に日付が入るようにです。
ご教授くださいませ。

回答No.2

Wendy02

こんにちは。

>たとえば、最初に受付１０５４までを印刷、次は受付１１３６までを印刷と印刷件数は不変であり、最初の時に１０５４までの印刷日に全て日付が入力、

この部分は、もうすでにあるのですか？私は、何度か、hirosatonnさんには回答していますが、該当するコードが見当たりません。

そこで、一応、それに見合うコードをこちら側で作ってみました。また、受付番号は、ファイル－プロパティ－ユーザー設定の記録番号に入れるようにしました。印刷範囲は、A列からT列までの範囲になっています。

今は、印刷の部分が、プレビューになっておりますが、Preview:=True を False に換えれば印刷しますが、すでに、マクロをお持ちなら、それを入れ替えてください。印刷の範囲は、すでに設定されています。

Sub MyPrint()
Dim LastNum As Long
Dim NewNum As Long
Dim Frow As Long
Dim Lrow As Long

　On Error GoTo MakeDocuProperty
　LastNum = ThisWorkbook.CustomDocumentProperties("記録番号").Value
　If LastNum = 0 Then Err.Raise 9

　On Error Resume Next
　Frow = Application.WorksheetFunction.Match(LastNum, Columns(1), 0)
　If Frow = 0 Then MsgBox "受付番号が見つかりません." & vbCrLf & _
　　　　　 "プロパティのユーザー設定を調べてみださい。", vbCritical: Exit Sub

　While Lrow = 0
　NewNum = Application.InputBox("前回の番号: " & CStr(LastNum) & "(+1)" & vbCrLf & _
　　　　　　　　"本日の最後の受付番号を入れてください", Type:=1)

　If NewNum = 0 Then Exit Sub
　Lrow = Application.WorksheetFunction.Match(NewNum, Columns(1), 0)
　If Lrow = 0 Then MsgBox "受付番号が見つかりません.", vbInformation
　Wend

　With ActiveSheet.Cells(Frow, 20).Resize(Lrow - Frow)
　　　.NumberFormatLocal = "yy/mm/dd"
　　　.Value = Date
　End With
　ThisWorkbook.CustomDocumentProperties("記録番号").Value = NewNum

　'A列から、T列までの印刷範囲設定
　ActiveSheet.PageSetup.PrintArea = _
　 ActiveSheet.Cells(Frow, 1).Resize(Lrow - Frow + 1, 20).Address
　'ここから印刷マクロを入れてください。
　'印刷マクロ例
　ActiveSheet.PrintOut , Preview:=True　'本当に印刷するときは、Preview はFalse

Exit Sub
MakeDocuProperty:
　 'カスタム（ユーザー）プロパティを作る
　 If Err.Number = 5 Then
　 LastNum = Application.InputBox("新規に記録番号を作りますので、今までの最後の番号を入れてください", Type:=1)
　 If LastNum = 0 Then MsgBox "0はいれないでください": Exit Sub
　 With ThisWorkbook.CustomDocumentProperties
　　　　.Add Name:="記録番号", _
　　　　 LinkToContent:=False, _
　　　　 Type:=msoPropertyTypeNumber, _
　　　　 Value:=LastNum
　 End With
　 Err.Clear
　 Resume Next
　 ElseIf Err.Number = 9 Then
　 LastNum = Application.InputBox("プロパティの記録番号の[最後の番号]が無くなっているようですから、" & vbCrLf _
　 & "新たに入力してください。", Type:=1)
　 ThisWorkbook.CustomDocumentProperties("記録番号").Value = LastNum
　 Resume Next
　 End If
　 MsgBox Err.Number & " :" & Err.Description
End Sub

補足

Wendy02さん　いつもありがとうございます。
>受付番号は、ファイル－プロパティ－ユーザー設定の記録番号に入れるようにしました。
ど素人ですみません。ユーザー設定の方法がわかりません。
質問時に載せればよかったのですが
私なりに考えたコ－ドでは印刷したい受付番号（最初から数百件分入力済み）以降も印刷し、日付は指定番号のみ入力となります。

'----- 印刷範囲 列指定 ---------
Const Sh = "入力シ－ト" '　　<----- シ－ト名指定
Const Left_Col = "A" '　　<------ 印刷範囲の左端列
Const Right_Col = "S" '　　<----- 印刷範囲の右端列
Const Target_Col = "T" '　<----- 印刷データ判定列（日付形式）
Const Prev_Mode = 1 '　　<----- 0 = 直接印刷 /　 1 = プレビュー
'------------------------------
Dim TopRw As Long
Dim EndRw As Long
Dim Target_Date As Date
Dim N As Long
Dim strCode As String
Dim rngSA As Range
Dim rngFC As Range
Dim shNum As Long

'検索する受付番号を取得
'文字列型で受ける
strCode = Application.InputBox("受付番号を入れてください。", "番号の入力", Type:=2)
'キャンセルの場合の処理
If UCase$(strCode) = "FALSE" Then Exit Sub

'受付番号の検索範囲を取得(A1～A列最終行まで）
With Sheets(Sh)
Set rngSA = .Range("A1", .Range("A65536").End(xlUp))
End With

'受付番号の検索範囲から入力された受付番号を探す
Set rngFC = rngSA.Find(What:=strCode, LookAt:=xlWhole)

'該当する受付番号が無ければ警告を表示して終了
If rngFC Is Nothing Then
MsgBox "受付番号がありません！", vbOKOnly Or vbCritical, "エラー"
Exit Sub
End If
With Worksheets(Sh)
EndRw = .Range(Left_Col & "65536").End(xlUp).Row

Target_Date = .Range(Target_Col & EndRw).Value

TopRw = EndRw
Do While .Range(Target_Col & TopRw).Value = _
.Range(Target_Col & TopRw).Offset(-1).Value
TopRw = TopRw - 1
If TopRw = 1 Then Exit Do
Loop
　 N = EndRw - TopRw + 1
.PageSetup.PrintArea = Range(Left_Col & TopRw & _
":" & Right_Col & EndRw).Address

If Err.Number > 0 Then
MsgBox "プリンタ－の準備が、出来ていません。"
Exit Sub
End If

’印刷した日付を印刷日へ
rngFC.Offset(0, 19).Value = Date

If Prev_Mode = 1 Then
.PrintOut Preview:=True

Else
.PrintOut Preview:=False

MsgBox Target_Date & " 印刷分を " & N & _
" 件 印刷しました。", , "印刷完了"
End If

.PageSetup.PrintArea = False

End With
End Sub