『マクロ 日付が入力された範囲の印刷』(igu) sheet1からsheet5までに表があるとします。 inputboxを使って開始の日付と終了の日付をそれぞれのsheetのA1セルに入力できるようにしたいのです。 例えば、sheetが30枚あるとして、9/1と9/30を入力したら各シートにその間の日付が入力されて、 且つ入力されたシートの表(枚数分)が印刷されるようにしたいのです。 いろいろ調べてここまできましたが、上記の例えのように最高で31日あるシートを常に作成しておき、 そこに日付が入力された枚数分だけ印刷されるようにすることができません。 わかる方、協力お願い致します。 Dim mydate1 As Variant mydate1 = Application.InputBox("開始日を入力して下さい!", "入力欄") If VarType(mydate1) = vbBoolean Then Exit Sub If IsDate(mydate1) = False Then MsgBox "日付が入力されていないようです。", vbExclamation Worksheets("sheet1").Range("A1").Value = mydate1 ---- こんにちは 説明が?です。 > sheet1からsheet5までに表があるとします。 > 例えば、sheetが30枚あるとして いったいシートは何枚あるんですか? > inputboxを使って開始の日付と終了の日付をそれぞれのsheetのA1セルに入力 それぞれのシートとは? コードを見ると Sheet1 だけみたいですけど。 終了日はどこへ入力するのですか? > 9/1と9/30を入力したら各シートにその間の日付が入力されて 各シートとは、日付に対応したシートという事ですか? それとも30枚(日付なら31枚?)有るシート全てに 9/1〜9/30 の日付を入力するのですか? > 日付が入力された枚数分だけ印刷 枚数とはシートの事ですか? (ウッシ) ---- シートが対象の日付のものであるかどうかを確認するのは、A1の値のようですが、 シートが日付順に左から右へ並んでいるなら、次のようなマクロでも可能かもしれません。   Sub test20100903() Dim sh As Worksheet Dim mydate1 As Long Dim mydate2 As Long mydate1 = Application.InputBox("開始日を入力して下さい!", "入力欄", , , , , , 1) mydate2 = Application.InputBox("終了日を入力して下さい!", "入力欄", , , , , , 1) For Each sh In Worksheets If mydate1 <= sh.Index And mydate2 >= sh.Index Then sh.PrintPreview ' sh.PrintOut End If Next End Sub   上記はInputboxに「1-31」の日付数字を入力するという前提です。 日付の妥当性のチェックまでは作りこんでいませんが。   ポイントはオブジェクトのループと判定部分。 目的の日付範囲のシートの判定は sh.Index(シートのインデックス番号) の代わりに セルの値 sh.Range("A1").Value でも良いのですが、 その場合は、Inputboxの入力の数値とセルの値の比較の仕方が課題になるでしょう。   なお、こういう失敗 ↓ はしませんように・・・。 [みやほりんの失敗談] http://miyahorinn.fc2web.com/schooltxt/Ex060120.html   現状が悪いといっているのではありません。 (みやほりん)(-_∂)b 初めてここに掲載するので不便をおかけすると思いますが、早速のお返事ありがとうございました。 文才がないものでうまく伝えられずすみません。 一番ベストなのは、同じシートないで同じ表を必要な分のページだけ作り、それを印刷したいのです。それをinputboxを使って、何月何日から何月何日と入力すれば自動で印刷までという運びにしたいのです。そして、各ページの左上(最初はA1、次はA58)に各日付が入力させたいのです。 もし、また不足があれば仰って下さい。どうかお願いします。 ---- こんにちは 表の左上に日付を入れると表の内容が完成するのですか? その辺りは分からないですが、表の雛形が Sheet1 に有るとして、Sheet2 に必要な分の表を作って印刷します。 ページ設定とかは別途必要です。 Sub test() Dim sh1 As Worksheet Dim sh2 As Worksheet Dim s As Variant Dim e As Variant Dim d As Long Dim i As Long Dim t As Range s = Application.InputBox("開始日を入力して下さい!", "入力欄", "2010/9/1", , , , , 2) If VarType(s) = vbBoolean Then Exit Sub If IsDate(s) = False Then MsgBox "日付が入力されていないようです。", vbExclamation e = Application.InputBox("終了日を入力して下さい!", "入力欄", "2010/9/30", , , , , 2) If VarType(e) = vbBoolean Then Exit Sub If IsDate(e) = False Then MsgBox "日付が入力されていないようです。", vbExclamation d = DateDiff("d", s, e) + 1 Set sh1 = Worksheets("Sheet1") '表の雛形があるシート Set sh2 = Worksheets("Sheet2") Set t = sh1.Range("A1:N57") '表雛形のセル範囲 With sh2 For i = 1 To d t.Copy .Cells(i * 57 - 56, 1) .Cells(i * 57 - 56, 1) = DateAdd("d", i - 1, s) Next .PrintPreview ' .PrintOut End With End Sub (ウッシ)