[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『印刷範囲設定について』（tomo）
帳票の印刷範囲について質問お願いします。
帳票の構成は以下です 10ページ構成
A～AI列
P1 1～39行
P2 40～78行
・・・
P10 352～383行
マクロを登録したボタンで
特定のセルに値があるかないかで何ページまで印刷するかをを決定 指定したい。
チェックする値は
C11 C50 C89 C128 C167 C206 C245 C284 C323 C362です。
現在は以下のマクロ登録で指定しているのですがボタン10個必要なので
自動化できればありがたいです。
Sub ページ1()
ActiveSheet.PageSetup.PrintArea = "$A$1:$AI$39"
End Sub
Sub ページ2()
ActiveSheet.PageSetup.PrintArea = "$A$1:$AI$78"
End Sub
・・・
Sub ページ10()
ActiveSheet.PageSetup.PrintArea = "$A$1:$AI$390"
End Sub
よろしくお願いします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
質問です。
たとえば ページ2 という処理は 1ページ目から2ページ目まで、ページ8 という処理は 1ページ目から8めーじめまで ということですか？
で、もしそうなら、ページ8 の場合、たとえば C50 に値がなく、他のページの該当のセルには値がある場合、 ページ1 と ページ2～ページ8 を印刷したいということですか？
それと
>>ボタン10個必要なので 自動化できればありがたいです。
自動化 とは？
１つのボタンで、各ページの該当のセルに値があるページのみをすべて印刷するということですか？
（β） 2017/03/07(火) 12:24
＞自動化 とは？
印刷は別のマクロで行いますので、印刷は不要で 印刷範囲だけ決定できればと思ってます。
よろしくお願いします
（tomo） 2017/03/07(火) 12:33
こんなことですか？
Sub ページすべて()
Dim r As Range
Dim p As Range
Dim x As Long
Set r = Range("A1:AI39")
ActiveSheet.PageSetup.PrintArea = ""
For x = 1 To 10
If r.Range("C10").Value <> "" Then
If p Is Nothing Then
Set p = r
Else
Set p = Union(p, r)
End If
End If
Set r = r.Offset(r.Rows.Count)
Next
If p Is Nothing Then
MsgBox "印刷すべき対象がありません"
Else
ActiveSheet.PageSetup.PrintArea = p.Address
End If
End Sub
（β） 2017/03/07(火) 12:34
Sub test()
Dim i As Long
Dim c As Range
For Each c In ActiveSheet.Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")
If c.Value Is Empty Then Exit For
i = i + 1
Next
ActiveSheet.Range("A1", ActiveSheet.HPageBreaks(i).Location.Offset(-1, 34)).PrintPreview
End Sub
あ、エラー処理は考えてません。
（まっつわん） 2017/03/07(火) 12:43
If c.Value Is Empty Then Exit For
エラー：オブジェクトが必要です。
出てしまいます。なに？（焦）
（tomo） 2017/03/07(火) 12:50
>C10→C11ですよね？
そうでした。老眼が進みすぎて・・・（汗）
>C11 C50 C89・・順に必ず値は入力していきます。
ここを読んでいませんでした。 この条件であれば、空白セルが現れたら、そのページまで としたらよかったですね。 アップしたコードでは最後までチェックしていますのでちょっと無駄。
ただし、まっつわんさんのやりかた（ページブレーク挿入）だとページブレークをいれたとしても、その下のページも 印刷対象になると思いますが。
（β） 2017/03/07(火) 15:05
＞まっつわんさんのやりかた（ページブレーク挿入）
その前にエラーで動かないんです
On Error Resume Nextが必要ですかね？
（tomo） 2017/03/07(火) 15:48
If c.Value = Empty Then Exit For
ですね。。。
動作確認してないのバレバレ＞＜
＞ただし、まっつわんさんのやりかた（ページブレーク挿入）だと
＞ページブレークをいれたとしても、その下のページも
＞ 印刷対象になると思いますが。
あ～れ～。。。
ページブレーク入れたつもりはないですが。。。
水平改ページの位置を取得して、
セル範囲で印刷のつもりです。
テスト環境作るの大変だなぁ。。。。
だめかも＾＾；
（まっつわん） 2017/03/07(火) 16:09
10ページなので最後まで処理しても、処理時間の違いは電子顕微鏡でみてもわからないくらいですが。 (C10 は C11 になおしてあります）
Sub ページすべて2()
Dim r As Range
Dim p As Range
Dim x As Long
Set r = Range("A1:AI39")
ActiveSheet.PageSetup.PrintArea = ""
For x = 1 To 10
If r.Range("C11").Value = "" Then Exit For
If p Is Nothing Then
Set p = r
Else
Set p = Union(p, r)
End If
Set r = r.Offset(r.Rows.Count)
Next
If p Is Nothing Then
MsgBox "印刷すべき対象がありません"
Else
ActiveSheet.PageSetup.PrintArea = p.Address
End If
End Sub
（β） 2017/03/07(火) 16:10
>ページブレーク入れたつもりはないですが。。。
あぁ、コードよく見ていませんでした。ごめんなさい。
ただ、いずれにしてもページブレークは厄介ですよね。 新規ブックで
なにもしないまま
MsgBox ActiveSheet.HPageBreaks(1).Location.Address
なんてコードを動かすとエラーになりますので。
（β） 2017/03/07(火) 16:20
Sub test()
Dim i As Long
Dim c As Range
For Each c In ActiveSheet.Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")
If c.Value = Empty Then Exit For
i = i + 1
Next
ActiveSheet.PrintOut to:=i
End Sub
ループをなくすのもありだけど、飛び飛びに入力された場合に困ったちゃんですね＾＾；
Sub test2()
With ActiveSheet
ActiveSheet.PrintOut to:=WorksheetFunction.CountA( _
.Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")), Preview:=True
End With
End Sub
飛び飛びでもいい風にも出来そうですね。。。
＞ 新規ブックで
＞ なにもしないまま
これはない前提でしょう。。。。。。。。。。
（まっつわん） 2017/03/07(火) 16:27
（まっつわん）さん
何度も考えていただき助かりました。
選択肢が増えて、良かったです。
一番いい方法をチョイスさせていただきます。
ありがとうございました。
もう一点すみません。が
帳票の最終行へJumpする方法教えてください
帳票の書き込み範囲は以下ですが
C11：AH32
C50：AH70
C89：AH110
・・・
C362：AH383
この範囲内でC11 C50 C89・・C362書込のある最終ページに
Jump(移動)したいのですがよろしくお願いします。
（tomo） 2017/03/07(火) 17:24
Sub Macro2()
With Range("C3,C8,C11,C15,C19")
.Find(What:="*", After:=.Areas(1), LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, _
MatchByte:=False, SearchFormat:=False).Select
End With
End Sub
あ、行優先の方がよかったかな？
マクロの記録をしてコードを確認してみてください。
あと、検索するセル範囲は、そちらの環境に合わせて変更願います。
（まっつわん） 2017/03/07(火) 19:19
最下行へ行きたいです。
説明が分かりにくくてすみません。
（tomo） 2017/03/07(火) 19:35
With Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")
.Find(What:="*", After:=.Areas(1), LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, _
MatchByte:=False, SearchFormat:=False).Select
End With
End Sub
（tomo） 2017/03/07(火) 19:43
With Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")
（tomo） 2017/03/08(水) 01:29
>tomo さん
遅ればせながら参加します。
下記トピック先でも、同じような事やってます。 [[20170302205205]] 『ページ毎に特定のセルの値を読み取って印刷するか否かを決めたい』
シートは、Sheet1だとして仮定してｺｰﾄﾞ書いています。使用しているシート名に変更してくださいね（★印）。 C11が空白の場合の印刷範囲は適当に、「$A$1:$AI$11」（■印）にしています。 ◆印（2箇所）は、お好みで、先頭の「'」を取るか、先頭に「'」を付けるかなどしてください。
質問ですが、C11,C50,…などの「判定を行う特定のセル」は、数式は入っていないですよね？ 当該セルでは、「空白」または、「手入力で文字列を入れている」のどちらかですよね？
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
Sub 改ページと印刷範囲の設定()
Dim sh As Worksheet, i As Long, k As Long, c As Range, cnt As Long
Set sh = ThisWorkbook.Sheets("Sheet1") '★シート名
sh.Activate
sh.PageSetup.PrintArea = ""
sh.ResetAllPageBreaks
For i = 1 To 10
k = (i - 1) * 39 + 11
Set c = sh.Range("C" & k)
If Len(Trim(c)) = 0 Then
Exit For
Else
cnt = cnt + 1
sh.HPageBreaks.Add before:=sh.Range("A" & 39 * cnt + 1)
End If
Next i
If cnt = 0 Then
sh.PageSetup.PrintArea = "$A$1:$AI$11" '■適当に設定した印刷範囲（間違って印刷しても1ページに収めるため）
MsgBox "印刷すべき対象がありません"
Else
sh.PageSetup.PrintArea = "$A$1:$AI$" & 39 * cnt
sh.PrintPreview '◆
'MsgBox "印刷範囲を設定しました" '◆
End If
Set sh = Nothing: Set c = Nothing
End Sub
（マリオ） 2017/03/08(水) 05:11
>tomo さん
>どのセルも未入力だった場合のエラー処理の方法を教えてください。 >ifを利用した処理方法はありますか？
熟睡中zzz のまっつわん さんに代わって(^^♪
まっつわんさんのコードをパクッテます。 ★シート名は、使用しているシート名に変更してください。
〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
Sub 移動2()
Dim sh As Worksheet, r As Range
Set sh = ThisWorkbook.Sheets("Sheet1") '★シート名
sh.Activate
'On Error Resume Next'◆エラーにならないので、不要です！
With Range("C11,C50,C89,C128,C167,C206,C245,C284,C323,C362")
Set r = .Find(What:="*", After:=.Areas(1), LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, _
MatchByte:=False, SearchFormat:=False)
End With
'On Error GoTo 0'◆エラーにならないので、不要です！
If r Is Nothing Then
Range("C11").Select
MsgBox "何も入力されていません" & vbCrLf & "移動先のセル：" & "C11"
Else
r.Select
MsgBox "入力済の最下行に移動しました" & vbCrLf & "移動先のセル：" & r.Address(False, False)
End If
Set sh = Nothing: Set r = Nothing
End Sub
（マリオ） 2017/03/08(水) 05:57
選択して画面に見せるのが目的でしょうから、
On Error ～ で逃げていいと思います。
ただ、On Error ～ を使いたくないなら、
Findメソッドの返り値を一旦変数に受けて、
その返ってきた値がNothingかどうかでエラー回避する手もあります。
がっちりアプリケーションとして作るなら、
If文でエラー回避した方がより良いでしょうが、
気軽な使い捨てマクロなら、
「選択できるセルが無いならエラーを無視して何もしない」
として深く悩まない手もあると思います。
（まっつわん） 2017/03/08(水) 09:47
（まっつわん）さん
ありがとうございました。
＞気軽な使い捨てマクロなら、
＞「選択できるセルが無いならエラーを無視して何もしない」
＞として深く悩まない手もあると思います。
確かに、本格的な物では無いと思います。がネットで
調べている内にif利用だと、どのように書くのか気になり
識者の方のご意見いただきたく質問でした。
無事 解決いたしました
皆様、本当にありがとうございました。
（tomo） 2017/03/08(水) 14:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.