- ベストアンサー
すみません。印刷マクロをもう一度
以前印刷マクロを教えていただいたのですが、もう一度お助けください シートに下のようなデータベースがあります。 受付番号 氏名 〒 住所・・・・・印刷日(T列) 1001 1002 1003 1004 ・ ・ ・ 印刷時に受付番号を入力することで印刷できるものです。 1回印刷したデ-タは次回は印刷範囲外で判断基準を印刷日とし印刷を実行した日に自動的に日付が印刷日に入力されるものをです。 たとえば、最初に受付1054までを印刷、次は受付1136までを印刷と印刷件数は不変であり、最初の時に1054までの印刷日に全て日付が入力、次は1136までの全ての印刷日に日付が入るようにです。 ご教授くださいませ。
- みんなの回答 (9)
- 専門家の回答
質問者が選んだベストアンサー
ご迷惑を掛けてすみません。 直しました。とりあえず、いままでのものを踏襲する形にしましたが、印刷範囲は、受付番号から最下行までの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
その他の回答 (8)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。Wendy02です。 すみません、返事をつけるのが遅くなって。 今、ちょっと手が離せなくて、もう少し、お待ちください。決して、投げ出したりはしませんから。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。Wendy02です。 私の文章は長すぎて、読みきれませんでしたか?閉口してしまったかもしれませんね。 >既存のものを直すというのは本当に難しいものなんですね。 いいえ、今回は、単に、その手順とか方法に問題があるのです。本来は、最初から私が作っていれば、おそらくは、終わっていることなのですが。 >Msg Boxを使って(最初と最後の番号をたずねる方式)、できないかなあ~と思い悩んでいます。 それ自体は、簡単なことなんですが、どういった手順をしているのか、まったくわからないのです。 それでは、ひとつだけ教えてください。 いままでのものを混乱させないようにさせるためには、どうしても必要です。元のマクロは読みきっても、元のマクロの手順は、いまだ疑問のままなのです。 それは、「印刷日」ということです。 もしかして、「印刷日」をマクロの前に処理していませんか? 何度みても、何かがヘンだなって思うのです。そうしないと、矛盾してしまうのです。 ’印刷した日付を印刷日へ rngFC.Offset(0, 19).Value = Date というような項目が発生しているので、これでは、何をしているのか、意味がわからないのです。私のロジックとして成り立たないのです。 ご自身で、説明しにくかったら、前のログを教えていただいたほうがわかりやすいのですが。 私は、この2年半間で、ここのカテゴリで、hirosatonnさんの質問は、7問中、6問までは回答しているのですが、その中にはないようです。 せめて、その1点だけでも教えてください。それがないと進めないのです。
補足
>私の文章は長すぎて、読みきれませんでしたか?閉口してしまったかもしれませんね とんでもありません。感謝しています。 >「印刷日」をマクロの前に処理していませんか? 印刷日はマクロでの入力でなく、件数が比較的すくなっかたので手入力でコピ-、貼り付けでやって、それからマクロで印刷処理していたので今度は自動的に入力をと考えて rngFC.Offset(0, 19).Value = Date のコ-ドを考えました。 前のログは Sub 最終処理分印刷() '----- 印刷範囲 列指定 --------- 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 With Worksheets(Sh) EndRw = .Range(Target_Col & "65536").End(xlUp).Row If Not IsDate(.Range(Target_Col & EndRw).Value) Then MsgBox "印刷するデ-タがありません。 終了します。" Exit Sub Else Target_Date = .Range(Target_Col & EndRw).Value End If 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 '"通知書”欄から"証券”欄までは印刷しない .Range("K1:N1").EntireColumn.Hidden = True If MsgBox("受付簿の印刷を開始します。印刷日は入力されていますか?", vbOKCancel, "確認") = vbOK Then If Prev_Mode = 1 Then .PrintOut Preview:=True Else 'ユーザーフォームによるメッセージ表示 UserForm2.Show vbModeless DoEvents .PrintOut Preview:=False 'メッセージ用のユーザーフォームを閉じる UserForm2.Hide MsgBox Target_Date & " 印刷分を " & N & _ " 件 印刷しました。", , "印刷完了" End If End If .PageSetup.PrintArea = False '印刷終了後"通知書”欄から"証券”欄まで再度表示 .Range("K1:N1").EntireColumn.Hidden = False End With End Sub
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。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さんご回答ありがとうございます。既存のものを直すというのは本当に難しいものなんですね。すみません。Wendy02さんの考えていただいたものを私は望んでいるのです。(表現が下手なもので・・) Msg Boxを使って(最初と最後の番号をたずねる方式)、できないかなあ~と思い悩んでいます。 あつかましくて申し訳ありませんが、お助け下さい。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。 >"受付番号が見つかりません。プロパティのユ-ザ-設定を調べてみてください。"になりました。 どうやら、私は、質問の意味を間違えているかもしれませんね。読み直してみたら、私は、よく分かっていないようでした。 >最初に受付1054までを印刷、次は受付1136までを印刷と印刷件数は不変であり、最初の時に1054までの印刷日に全て日付が入力、次は1136までの全ての印刷日に日付が入るようにです。 思い込みで、ここの内容は、ほとんど理解していませんでしたね。 >判断基準を印刷日とし印刷を実行した日に自動的に日付が印刷日に入力されるものをです。 ここもわかっていませんでした。 判断基準を、受付番号とせずに、印刷日になっているというのは、どうしてなのか、分かりません。どうやって判断したらよいのか、分からないのです。 ちょっともう一度確認したいのですが、こういうことではないでしょうか? 1054 までを印刷していたら、次は、1055 ~ 1136 として、印刷日(T列)に日付が入って、その範囲を印刷するということではないのですか? だから、設定されていない、1054 までは、最初に、プロパティのところで、設定していただかないと、次に進めないような仕組みになっているのです。 >以前ja7awuさんなどに助けていただいたコ-ドに自分で手を加えたものです。 なお、私は、ご質問者以外のコードは原則的には触りませんのでご了承ください。もし、掲示されたレベルの技術があれば、今のお使いのコードのどこの部分を、どういう方法にしたいのか、ポイントを絞ってくださったほうがよいかもしれません。 私自身の技術的な問題だとは思いませんが、文章の理解には限界があります。
補足
こんばんは。Wendy02さん、回答ありがとうございます。 ›1054 までを印刷していたら、次は、1055 ~ 1136 として、印刷日(T列)に日付が入って、その範囲を印刷するということではないのですか? わたしが言いたかったのはそのとおりです。 ›文章の理解には限界があります。 文章表現が下手で大変申し訳なく思います。 ›判断基準を、受付番号とせずに、印刷日になっているというのは、どうしてなのか、分かりません。 受付番号はすでに入力済み(5000件分)で印刷日での判断でやっていたのですが、もう少し良い方法をと言うことで、試行錯誤中の最中です。 受付番号の隣(B列)に顧客名(都度入力)がありますので、それを判断基準(印刷最初の番号;最後の番号を入力)としての印刷を考えてます。 コ-ドの 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 Target_Date 部分と .Offset(-1) 部分を 変更すればいいのかと未熟者が考えています。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。 今、一通りコードを読みましたが、申し訳ないのですが、正直なところ、内容的には、出来上がっているコードですね。そのコード自体はいじりたくないですね。それと、内容的には、比較的平易な内容ですが、無くて七癖なんです。 一応、確認ですが、ご自身が書いたコードですか?
補足
Wendy02に書いていただいたコ-ド実行すると、 "受付番号が見つかりません。プロパティのユ-ザ-設定を調べてみてください。"になりました。 載せたコ-ドは 以前ja7awuさんなどに助けていただいたコ-ドに自分で手を加えたものです。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。Wendy02です。 とりあえず、ひとつだけ。 >ユーザー設定の方法がわかりません。 別に必要ありません。作ってなければ、自動的に入りますので、実行すればよいです。 後は、メニューからファイル-プロパティ-ユーザー設定をみると、番号が記録されています。次回には、その番号が呼び出されます。 なお、 If Err.Number > 0 Then MsgBox "プリンタ-の準備が、出来ていません。" Exit Sub これで、問題なければよいのですが、コードの意味が違うような気がします。 後は、もう一度、見直してみます。
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 >たとえば、最初に受付1054までを印刷、次は受付1136までを印刷と印刷件数は不変であり、最初の時に1054までの印刷日に全て日付が入力、 この部分は、もうすでにあるのですか?私は、何度か、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
- Yes_No_F
- ベストアンサー率40% (4/10)
要求どうりか分かりませんが。。。。。。 ためしてみて下さい。。 ---------------------------------------------------------- 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
補足
早々にありがとうございます。 〉Set R = Rows(lastRow + 1) エラ-'1004'が出ます。 モジュールへコ-ドをコピ-しましたが私のやり方がおかしいのでしょうね。
お礼
大変遅くなりましたが、希望する物ができました。 ありがとうございました。