印刷範囲をinputBOXで選択し、最終行を取得して印刷プレビュー

投稿者 : けろ     投稿日時 : 2024/09/04(Wed) 14:12:54     OS : Windows 10     EXCEL : Excel 2013

---

【現状】
1年単位の集計シートで、その年の1月～12月までの機械稼働集計を1つのシートにまとめています。

1ヶ月につき11列分使っています。それが右に向かって横にずらずらと繰り返し11列ごとに並んでいます。
1月11列、2月も11列、3月も11列…の繰り返しで12月までで1シートです。


例えば9月分だけを印刷したい時に、現状のプログラムでいえばBD:BN列をドラッグ選択して列指定しています。
そうすると、行方向に大量に引かれた罫線の最終行まで全部印刷エリアになってしまい、大変な事になってしまいました。
列指定せず、データがあるBD1:BD最終行までドラッグしながら目で範囲指定してもよいですが、大量にありスクロールが大変で目が追いづらい事情も出てきました。なので最終行も取得したいと思うようになりました。

そもそも印刷範囲をインプットボックスなんかでせずにエクセル機能の印刷範囲を手動で指定していっても良いですが、年配の方がそれを理解できません。
できるなら列をドラッグしてボタンひとつでできるようにしたいです。

【質問内容】
インプットボックスで列を指定したとしても選択範囲の11列の中にあるデータ最終行までを取得して、印刷プレビューに持っていきたいです。
そもそも考え方が間違っておりましたらご指摘ください。

よろしくお願いいたします。

' 印刷範囲選択
Private Sub printBT_Click()
           
On Error Resume Next
Dim strPrintMessage As String


'InputBoxでセル入力後、OKでセル範囲を格納
strPrintMessage = "印刷範囲をマウスで選択してください。"
Dim inputCell As Range
Set inputCell = Application.InputBox(Prompt:=strPrintMessage, Type:=8)

'InputBoxでキャンセルが押されたときは、処理を抜ける
If inputCell Is Nothing Then
Exit Sub
End If

'選択したセル範囲で印刷プレビュー実施
With ActiveSheet
.PageSetup.PrintArea = inputCell.Address '印刷範囲を設定
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = False
.PrintPreview

.PageSetup.PrintArea = "" '印刷範囲をクリア
.View = xlPageBreakPreview
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With


End Sub

投稿者 : こんなのとか     投稿日時 : 2024/09/04(Wed) 15:04:32

---

ActiveSheet.PageSetup.PrintArea = "A2:B10"
ActiveSheet.PrintPreview

投稿者 : こんなのとか     投稿日時 : 2024/09/04(Wed) 15:07:02

---

すでにでてた・・・
失礼しました

投稿者 : さんこう     投稿日時 : 2024/09/04(Wed) 16:17:50

---

参考になれば。

＜vba 最終行の取得＞
https://www.google.com/search?q=vba+%E6%9C%80%E7%B5%82%E8%A1%8C%E3%81%AE%E5%8F%96%E5%BE%97


※余談です。

1ヶ月分を印刷するなら、インプットボックスで「月」を指定するようにしたらよろしいかと思います。

投稿者 : ごんぼほり     投稿日時 : 2024/09/04(Wed) 17:17:32

---

こんな感じですか？

Sub sample()
   m = InputBox("何月ですか(1～12)")
   If Val(m) < 1 Or Val(m) > 12 Then MsgBox "範囲外です", vbExclamation: Exit Sub
 
   c = ((m + 8) Mod 12) * 11 + 1
   ActiveSheet.PageSetup.PrintArea = Range(Cells(1, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 11).Address
   ActiveSheet.PrintPreview

End Sub

投稿者 : けろ     投稿日時 : 2024/09/06(Fri) 09:38:34

---

少々苦戦しております。
すみませんお返事が遅くなりました。

やはり選択範囲の最終行を取得するのは難しいですよね。
もう少しチャレンジしたいと思います。

投稿者 : ピロリ     投稿日時 : 2024/09/06(Fri) 09:56:10

---

■[返信 5] けろさん（2024-09-06 09:38:34）の記事
＞ 少々苦戦しております。
＞ やはり選択範囲の最終行を取得するのは難しいですよね。
[返信 4] ごんぼほりさんのコードで上手くいかないって、列によって最終行が変わるってことですかね？？？
プレビュー範囲の全列をループして、一番下のデータ行を調べないといけないとか･･･？

何を苦戦されているのか、現状のコードのどこがどう上手くいかないのか掲示すると、良いアドバイスが得られると思いますよ。

投稿者 : けろ     投稿日時 : 2024/09/06(Fri) 13:19:57

---

お世話になります。
ご指摘の通りですm(__)m

＞ごんぼほりさんのコードで上手くいかないって、列によって最終行が変わるってことですかね？？？
＞ プレビュー範囲の全列をループして、一番下のデータ行を調べないといけないとか･･･？

その通りです。
範囲によって最終行が違いますので、最終行を取得するのに苦労しております。

1月はA列～K列、2月はL列～V列、3月、4月・・・・と続きます。
1月～12月までそれぞれ最大行はまちまちです。

今のinputbox記述だと、1月を印刷したい時は、A列～K列を一気に列選択していますので罫線しかない下の方の空行まで印刷されてしまいます。
行は100行で済む月もあれば、500行、800行とその月によってまちまちです。




■[返信 6] ピロリさん（2024-09-06 09:56:10）の記事
＞ ■[返信 5] けろさん（2024-09-06 09:38:34）の記事
＞ ＞ 少々苦戦しております。
＞ ＞ やはり選択範囲の最終行を取得するのは難しいですよね。
＞ [返信 4] ごんぼほりさんのコードで上手くいかないって、列によって最終行が変わるってことですかね？？？
＞ プレビュー範囲の全列をループして、一番下のデータ行を調べないといけないとか･･･？
＞
＞ 何を苦戦されているのか、現状のコードのどこがどう上手くいかないのか掲示すると、良いアドバイスが得られると思いますよ。
＞

投稿者 : さんこう     投稿日時 : 2024/09/06(Fri) 13:41:50

---

＞範囲によって最終行が違いますので、最終行を取得するのに苦労しております。

範囲内の各列の最終行を取得し、その最大値を求めればいいでしょう。


参考になれば。

Sub MaxRow()
    mr = 0
    For c = 1 To 11　'A-K列
        mr = WorksheetFunction.Max(mr, Cells(Rows.Count, c).End(xlUp).Row)
    Next
    MsgBox mr
End Sub

投稿者 : ピロリ     投稿日時 : 2024/09/06(Fri) 16:22:04

---

すでに、さんこうさんから最終行の求め方が提示されているので、「じゃ、どの列からどの列までループすりゃ･･･」って話です。

例えば、A1～C4セルの範囲（ Range("A1:C4") ）なら、1番目は A1，2番目は B1，･･･ ，11番目は B4，最後は C4セルです。
つまり、セル範囲が「inputCell」ということなら、
・inputCellの左端の列番号は、inputCell(1).Column　　　　　　　　　← 1番目（左上）のセルの列番号
・inputCellの右端の列番号は、inputCell(inputCell.Count).Column　　← 最後（右下）のセルの列番号

後は、さんこうさんがコードのご提示をされていますので、割愛させていただきます。

投稿者 : けろ     投稿日時 : 2024/09/06(Fri) 16:50:00

---

皆様できました！ありがとうございます！！！
一応動きましたが、変な記述でしたらすみません。
こんな感じで良いでしょうか。

On Error Resume Next

Dim strPrintMessage As String

'InputBoxでセル入力後、OKでセル範囲を格納
strPrintMessage = "印刷範囲をマウスで選択してください。"
Dim inputCell As Range

Set inputCell = Application.InputBox(Prompt:=strPrintMessage, Type:=8)
Set inputrowCell = Range("inputCell", Cells(Rows.Count, 1).End(xlUp))

'InputBoxでキャンセルが押されたときは、処理を抜ける
If inputCell Is Nothing Then
Exit Sub
End If

    Dim iColStart   '// 先頭列
    Dim iColEnd     '// 最終列

    '// 先頭列
    iColStart = Selection.Column
    '// 列数
    iColCount = Selection.Columns.Count
    '// 最終列
    iColEnd = iColCount + iColStart - 1

  mr = 0
    For C = iColStart To iColEnd  'A-K列
        mr = WorksheetFunction.Max(mr, Cells(Rows.Count, C).End(xlUp).row)
        Range(Cells(1, inputCell(1).Column), Cells(mr, inputCell(inputCell.Count).Column)).Select
        
    Next

'選択したセル範囲で印刷プレビュー実施
With ActiveSheet
.PageSetup.PrintArea = Selection.Address '印刷範囲を設定
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = False
.PrintPreview

.PageSetup.PrintArea = "" '印刷範囲をクリア
.View = xlPageBreakPreview
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
End With

end sub

投稿者 : さんこう     投稿日時 : 2024/09/06(Fri) 17:25:26

---

＞一応動きましたが、

エラーになりますし、それを修正しても期待した動作をしませんが、そちらでは動くということですね。


＞こんな感じで良いでしょうか。


不要なコードもあるようですから、理解しながら整理していくといいでしょう。

投稿者 : けろ     投稿日時 : 2024/09/06(Fri) 20:14:28

---

エラーになりましたでしょうか。
なぜこちらはエラーにならないのでしょうか。
もう少し調べます。
ありがとうございます。

投稿者 : さんこう     投稿日時 : 2024/09/06(Fri) 20:28:36

---

＞なぜこちらはエラーにならないのでしょうか。

申し訳ありません。

欄外に書いてあった「On Error Resume Next」を見逃してました。

とはいえ、必要ないものですから、エラーが出る状態にして

修正しておくといいでしょう。

投稿者 : けろ     投稿日時 : 2024/09/06(Fri) 21:10:52

---

On Errorは削除して、プログラム修正してみます！
少し考えてみますm(__)m。

ありがとうございます。



■[返信 13] さんこうさん（2024-09-06 20:28:36）の記事
＞ ＞なぜこちらはエラーにならないのでしょうか。
＞
＞ 申し訳ありません。
＞
＞ 欄外に書いてあった「On Error Resume Next」を見逃してました。
＞
＞ とはいえ、必要ないものですから、エラーが出る状態にして
＞
＞ 修正しておくといいでしょう。
＞

投稿者 : けろ     投稿日時 : 2024/09/07(Sat) 19:52:16

---

一応動くのは動いたのですが答え合わせがわからないです…
どのあたりがおかしいか教えていただきたいです。

Private Sub testBT_Click()

Dim strPrintMessage As String
Dim inputCell As Range
Dim iColStart   '// 先頭列
Dim iColEnd     '// 最終列


strPrintMessage = "印刷範囲をマウスで選択してください。"   'InputBoxでセル入力後、OKでセル範囲を格納
Set inputCell = Application.InputBox(Prompt:=strPrintMessage, Type:=8)
iColStart = Selection.Column '先頭列
iColCount = Selection.Columns.Count '列数
iColEnd = iColCount + iColStart - 1 '最終列


'InputBoxでキャンセルが押されたときは、処理を抜ける
If inputCell Is Nothing Then
Exit Sub
End If

mr = 0
For C = iColStart To iColEnd  '選択範囲の最初の列から最終列まで繰り返す
   mr = WorksheetFunction.Max(mr, Cells(Rows.Count, C).End(xlUp).Row)  '←ここで最初列の最終行から最終列の最終行をForで繰り返して探している？
        Range(Cells(1, inputCell(1).Column), Cells(mr, inputCell(inputCell.Count).Column)).Select  '←ここで1行目の最初列から、上のmrで求めた最終行のインプットセルに入れた最終列を選択している？
Next
    
Unload UserForm1 'プレビュー中はuserform1とじる

With ActiveSheet '選択したセル範囲で印刷プレビュー実施
.PageSetup.PrintArea = Selection.Address '印刷範囲を設定
.PageSetup.FitToPagesWide = 1 '横1ページ
.PageSetup.FitToPagesTall = False  '縦自動
.PrintPreview  'プレビュー
End With

UserForm1.Show vbModeless   '元の画面に戻ったらuserform1立ち上げる

End Sub

投稿者 : さんこう     投稿日時 : 2024/09/07(Sat) 20:15:14

---

＞一応動くのは動いたのですが答え合わせがわからないです…

動くのであれば、何を「答え合わせ」する必要があるのですか？

希望通りに動かないのであれば、どういった問題があるのか正しく認識することが重要です。

投稿者 : けろ     投稿日時 : 2024/09/07(Sat) 21:35:59

---

確かにそうですね！一旦は思い通りには動きましたので解決いたしましたありがとうございます！

投稿者 : ピロリ     投稿日時 : 2024/09/08(Sun) 09:05:36

---

解決済にはなってますが･･･
■[返信 17] けろさん（2024-09-07 21:35:59）の記事
＞ 一旦は思い通りには動きましたので・・・
含みのある記載ですが、思い通りに動かないときもあるってことでしょうか？
もし意図した結果が得られない場合、まずは下の値を確認してみて下さい。
　iColStart = Selection.Column '先頭列
　iColCount = Selection.Columns.Count '列数
　iColEnd = iColCount + iColStart - 1 '最終列
｢ Select ｣（選択）もしていないのに、｢ Selection ｣（選択部を参照）しているのが気になります。
老婆心ながら･･･