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

Question

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

Wendy02 · Accepted Answer

ご迷惑を掛けてすみません。
直しました。とりあえず、いままでのものを踏襲する形にしましたが、印刷範囲は、受付番号から最下行までのS列に設定されます。印刷の最中に、UserFormを使用するなら、UserForm上のどこかにラベルを作って、そこに、メッセージを出せば、MsgBox は必要ありません。



Sub TestSample2()
　　'----- 印刷範囲 列指定 ---------
　　Const SHNAME As String = "入力シ－ト" '　　<----- シ－ト名指定
　　Const L_COL As Integer = 1 '"A" '　　<------ 印刷範囲の左端列
　　Const R_COL As Integer = 19 '"S" '　　<----- 印刷範囲の右端列
　　Const DATE_COL As Integer = 20 ' "T" '　<----- 印刷データ判定列（日付形式）
　　Const PREV_MODE As Integer = 1 '　　<----- 0 = 直接印刷 /　 1 = プレビュー
　　Const DT_FORMAT As String = "M月D日" '<-----印刷日の書式
　　
　　Dim SearchWd As Variant
　　Dim c As Range
　　Dim rw As Long
　　Dim LastCell As Range
　　Dim myPrintArea As Range
　　Dim myDate As Variant
　　Dim addmsg As String
　　
　　myDate = Date '本日の日付
　　addmsg = Format$(myDate, DT_FORMAT) & "を" & vbCrLf
　　If MsgBox("印刷日は、" & Format$(myDate, DT_FORMAT) & "にしますがよろしいですか？", vbYesNo) = vbNo Then
　　　　Do
　　　　　　Application.SendKeys "{F2}"
　　　　　　Application.SendKeys "{HOME}"
　　　　　　myDate = Application.InputBox(addmsg & "変更してください。", "日付入力", _
　　　　　　Format$(myDate, DT_FORMAT), Type:=2)
　　　　　　If VarType(myDate) = vbBoolean Or myDate = "" Then Exit Sub
　　　　　　If IsDate(myDate) = False Then addmsg = "日付式が違います。" & vbCrLf
　　　　Loop While IsDate(myDate) = False
　　　　　　
　　End If
　　　　　　
　　　　　　With Worksheets(SHNAME)
　　　　　　　　If WorksheetFunction.CountA(.Range("A1").CurrentRegion) < 2 Then
　　　　　　　　　　MsgBox "データがありません。マクロを終了します", vbInformation: Exit Sub
　　　　　　　　End If
　　　　　　　　
　　　　　　　　SearchWd = Application.InputBox("【受付番号】を入力してください。", "番号入力", Type:=2)
　　　　　　　　If VarType(SearchWd) = vbBoolean Or SearchWd = "" Then MsgBox "終了します。": Exit Sub
　　　　　　　　
　　　　　　　　Set c = .Columns(L_COL).Find( _
　　　　　　　　What:=SearchWd, _
　　　　　　　　LookIn:=xlValues, _
　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　SearchOrder:=xlByColumns, _
　　　　　　　　MatchByte:=False)
　　　　　　　　
　　　　　　　　If c Is Nothing Then
　　　　　　　　　　MsgBox SearchWd & " は、受付番号列からは見当たりません。" & vbCrLf & _
　　　　　　　　　　"終了します。", vbInformation
　　　　　　　　　　Exit Sub
　　　　　　　　Else
　　　　　　　　　　Set LastCell = .Range("A65536").End(xlUp)
　　　　　　　　　　Set myPrintArea = .Range(c, LastCell.Offset(, R_COL - 1))
　　　　　　　　　　If MsgBox("'" & myPrintArea.Address & "' の受付簿の印刷を開始します。" & _
　　　　　　　　　　　　"印刷日( " & Format(myDate, DT_FORMAT) & " )は、印刷と同時に、" & Chr(DATE_COL + 64) _
　　　　　　　　　　　　& "　列に設定されます。", vbOKCancel) = vbCancel Then
　　　　　　　　　　　　Exit Sub
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　
　　　　　　　　'日付を入力
　　　　　　　　myPrintArea.Columns(DATE_COL).Resize(, 1).NumberFormatLocal = DT_FORMAT
　　　　　　　　myPrintArea.Columns(DATE_COL).Resize(, 1).Value = myDate
　　　　　　　　
　　　　　　　　'"通知書”欄から"証券”欄までは印刷しない
　　　　　　　　.Range("K1:N1").EntireColumn.Hidden = True
　　　　　　　　.PageSetup.PrintArea = myPrintArea.Address
　　　　　　　　If PREV_MODE = 1 Then
　　　　　　　　　　.PrintOut Preview:=True
　　　　　　　　Else
　　　　　　　　　　UserForm2.Show vbModeless
　　　　　　　　　　DoEvents
　　　　　　　　　　.PrintOut Preview:=False
　　　　　　　　　　
　　　　　　　　　　Unload UserForm2
　　　　　　　　　　MsgBox myDate & " 印刷分を " & myPrintArea.Rows.Count & "件印刷しました。", , "印刷完了"
　　　　　　　　End If
　　　　　　　　.PageSetup.PrintArea = ""
　　　　　　　　
　　　　　　　　'印刷終了後"通知書”欄から"証券”欄まで再度表示
　　　　　　　　.Range("K1:N1").EntireColumn.Hidden = False
　　　　　　
　　　　　　End With

End Sub

Wendy02 · Answer

こんばんは。Wendy02です。

すみません、返事をつけるのが遅くなって。
今、ちょっと手が離せなくて、もう少し、お待ちください。決して、投げ出したりはしませんから。

Wendy02 · Answer

こんにちは。Wendy02です。

私の文章は長すぎて、読みきれませんでしたか？閉口してしまったかもしれませんね。

>既存のものを直すというのは本当に難しいものなんですね。
いいえ、今回は、単に、その手順とか方法に問題があるのです。本来は、最初から私が作っていれば、おそらくは、終わっていることなのですが。

>Msg Boxを使って（最初と最後の番号をたずねる方式）、できないかなあ～と思い悩んでいます。

それ自体は、簡単なことなんですが、どういった手順をしているのか、まったくわからないのです。

それでは、ひとつだけ教えてください。

いままでのものを混乱させないようにさせるためには、どうしても必要です。元のマクロは読みきっても、元のマクロの手順は、いまだ疑問のままなのです。

それは、「印刷日」ということです。
もしかして、「印刷日」をマクロの前に処理していませんか？
何度みても、何かがヘンだなって思うのです。そうしないと、矛盾してしまうのです。

’印刷した日付を印刷日へ
rngFC.Offset(0, 19).Value = Date

というような項目が発生しているので、これでは、何をしているのか、意味がわからないのです。私のロジックとして成り立たないのです。

ご自身で、説明しにくかったら、前のログを教えていただいたほうがわかりやすいのですが。

私は、この2年半間で、ここのカテゴリで、hirosatonnさんの質問は、7問中、6問までは回答しているのですが、その中にはないようです。

せめて、その1点だけでも教えてください。それがないと進めないのです。

Wendy02 · Answer

こんにちは。Wendy02です。

>Target_Date　部分と .Offset(-1)　部分を
>変更すればいいのかと...考えています。

遅くなりましたが、もう一度、見直して、そして、コードを読みきり、問題点が分かりました。

それは、実際に動かしてみても、そのマクロの意味が理解できないのです。たぶん、前の段階では、きちんと説明されたから、そのマクロが出来上がったものだと思います。ただ、hirosatonnさんの希望通りだったのかは、かなり疑問が残ります。だから、質問を再度出されたものだと思います。そのマクロだけですと、ここでは出ていない、無駄があるのではないでしょうか？

今回のご質問自体、その印刷日の付け方、受付番号の付け方など、基礎的な情報が欠けてしまって、途中から、他人のコードを直すというのは、出来ないことがわかりました。ログがあれば、少しは違うはずです。これは、このままでは、前回回答された方以外は、誰が回答しても同じ結果になると思います。

ご指摘された、この部分ですが、

　　'ここは、A列の最後の行を探していますが、つまり、受付番号の最後です。
　　EndRw = .Range(Left_Col & "65536").End(xlUp).Row
　　'つまり、ここでは、日付が入っているということになります？
　　'そこが意味が分かりません。日付というのは、印刷日だったと思います。
　　'印刷日を入れているのだから、印刷しないはずでは？？・
　　Target_Date = .Range(Target_Col & EndRw).Value
　　'以下は、同じ日付の部分を戻って探しているようです。
　　　　 Do While .Range(Target_Col & TopRw).Value = _
　　　　　　.Range(Target_Col & TopRw).Offset(-1).Value
　　　　　　TopRw = TopRw - 1
　　　　　　If TopRw = 1 Then Exit Do
　　　　Loop
　　　・
　　　・
　　　・
　　　　'印刷した日付を印刷日へ
　　　　'そして、検索した受付番号を再び、本日の印刷日付に入れている？？
　　　　rngFC.Offset(0, 19).Value = Date
　　　　
特に、よく分からないのは、受付番号が、最後まで入っていることですね。
最後を探して、そこの印刷日付を取っているのです。
EndRw = .Range(Left_Col & "65536").End(xlUp).Row

なのに、最初に、受付番号を探しているわけです。
そして、印刷したら、rngFC.Offset(0, 19).Value = Date　と、本日の日付を入れるのでは、その論理自体が分からないです。 私は、ここのところ、花粉症で頭が痛くて、頭がボケていたようです。（^^;

言い換えれば、印刷日と受付番号の因果関係が分かりません。印刷日に対して、再び、印刷しているのでは、矛盾しています。

印刷日は毎日するものかどうかは別ですが、少なくとも、印刷する前に日付が入っていたら、その部分は印刷はしませんよね。
----------------------------------------------------------------

まず、前のことは一応置いておいて、私の考え方を理解してください。単純ですから！

>判断基準(印刷最初の番号；最後の番号を入力)

私の考えたのは、最初の番号は、次には、最後の番号の手前になるわけだと思うのです。

単に、その部分で範囲を設定するなら、本当にシンプルに範囲を取るだけで、印刷日付を入れるにしても、単純に、その範囲に日付を入れるだけです。

前回、「1025～　1175」が範囲なら、 次は、「1176 ～ 1265」というようなものになりますから、'1175' を確保しておけば、次に使えるわけです。つまり、それが途中から始まる場合は、最初に、'1175' が登録されていなければなりません。'1265'　は、新規にユーザーが入力して探すようなプログラムを作ります。

「1025～　1175」のT列の印刷日は前回の日付。印刷する前は「1176 ～ 1265」は、空欄で、印刷してから印刷日が入ります。

ただ、前回の番号'1175'が、正しく登録されていないと、今回のような「プロパティを見てください」というエラーが出ます。

その場合、手動で行うには、ワークシートメニューのファイル－プロパティ－ユーザー設定－「記録番号」に正しく登録する必要があります。（一応、自動的に登録されるように出来てはいます）

そのエラーの原因がはっきりしないと、こちらのコードは進みません。この部分がクリアしない限りは、私の今考えているものは、無理です。

既存のものを直すというのは、考え直したほうがよいです。考え方のロジックが、明確にならない限りは、それは使えませんね。ただし、私には、そのマクロのロジックが理解できません。

考え方は、理解していただけましたでしょうか？
個々の技術的な問題は別ですが、考え方としては、シンプルだと思います。

Wendy02 · Answer

こんばんは。

>"受付番号が見つかりません。プロパティのユ－ザ－設定を調べてみてください。"になりました。

どうやら、私は、質問の意味を間違えているかもしれませんね。読み直してみたら、私は、よく分かっていないようでした。

>最初に受付１０５４までを印刷、次は受付１１３６までを印刷と印刷件数は不変であり、最初の時に１０５４までの印刷日に全て日付が入力、次は１１３６までの全ての印刷日に日付が入るようにです。

思い込みで、ここの内容は、ほとんど理解していませんでしたね。

>判断基準を印刷日とし印刷を実行した日に自動的に日付が印刷日に入力されるものをです。
ここもわかっていませんでした。

判断基準を、受付番号とせずに、印刷日になっているというのは、どうしてなのか、分かりません。どうやって判断したらよいのか、分からないのです。

ちょっともう一度確認したいのですが、こういうことではないでしょうか？

1054 までを印刷していたら、次は、1055 ～ 1136 として、印刷日（T列）に日付が入って、その範囲を印刷するということではないのですか？

だから、設定されていない、1054 までは、最初に、プロパティのところで、設定していただかないと、次に進めないような仕組みになっているのです。

>以前ja7awuさんなどに助けていただいたコ－ドに自分で手を加えたものです。

なお、私は、ご質問者以外のコードは原則的には触りませんのでご了承ください。もし、掲示されたレベルの技術があれば、今のお使いのコードのどこの部分を、どういう方法にしたいのか、ポイントを絞ってくださったほうがよいかもしれません。

私自身の技術的な問題だとは思いませんが、文章の理解には限界があります。

Wendy02 · Answer

こんばんは。

今、一通りコードを読みましたが、申し訳ないのですが、正直なところ、内容的には、出来上がっているコードですね。そのコード自体はいじりたくないですね。それと、内容的には、比較的平易な内容ですが、無くて七癖なんです。

一応、確認ですが、ご自身が書いたコードですか？

Wendy02 · Answer

こんばんは。Wendy02です。

とりあえず、ひとつだけ。
>ユーザー設定の方法がわかりません。

別に必要ありません。作ってなければ、自動的に入りますので、実行すればよいです。

後は、メニューからファイル－プロパティ－ユーザー設定をみると、番号が記録されています。次回には、その番号が呼び出されます。

なお、
If Err.Number > 0 Then
MsgBox "プリンタ－の準備が、出来ていません。"
Exit Sub

これで、問題なければよいのですが、コードの意味が違うような気がします。

後は、もう一度、見直してみます。

Wendy02 · Answer

こんにちは。

>たとえば、最初に受付１０５４までを印刷、次は受付１１３６までを印刷と印刷件数は不変であり、最初の時に１０５４までの印刷日に全て日付が入力、

この部分は、もうすでにあるのですか？私は、何度か、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

Yes_No_F · Answer

要求どうりか分かりませんが。。。。。。
ためしてみて下さい。。
----------------------------------------------------------
Option Explicit

Sub test()
Dim I As Long
Dim lastRow As Long
Dim R As Range
Dim T As Integer
Dim B As Integer

lastRow = Range("a1").End(xlDown).Row
Set R = Rows(lastRow + 1)

T = InputBox("印刷範囲の最初の番号入力。")
B = InputBox("印刷範囲の最後の番号入力。")

For I = 2 To lastRow
    If Cells(I, 1).Value < T Or Cells(I, 1).Value > B Then
        Set R = Union(R, Rows(I))
    Else
        Cells(I, 20) = Now()
    End If
Next I
R.EntireRow.Hidden = True
Set R = Nothing
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rows("2:65536").EntireRow.Hidden = False

End Sub

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

ご迷惑を掛けてすみません。

こんばんは。

こんにちは。

この回答への補足

こんにちは。

この回答への補足

こんばんは。

この回答への補足

こんばんは。

この回答への補足

こんばんは。

こんにちは。

この回答への補足

要求どうりか分かりませんが。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング