エクセル印刷で上下の結合セルが別ページにならない方法？

質問

エクセル2000です。
一枚のシートに表が複数あります。
表中のセルはすべて数式が入っています。
A列は続き番号がふってあります。
B列～E列は上下のセルが結合しています。（2行分）
F列は結合していません。
G列は上下の結合あります。（2行分）

このような様式の表が、同一シートに1行あけて上から下へ続いています。
しかも、計算結果により表中の行が空白になる場合がよくあります。
その場合、は表中の空白行は非表示になるようにマクロで設定しています。

このシートを印刷した場合、2行を上下で結合したセルが、別ページに分かれてしまうことがよくあります。計算結果で表示がかわるので改ページを事前に入れておけません。

結合セルがページで分割されないようにするにはどうしたらよいでしょうか？

回答No.7

KenKen_SP · ベストアンサー

> Application.ScreenUpdating = Trueがはいっていましたが、画面の更新を
> とめていると水平改ページ調整サブプロシージャは作動しないのでしょうか？

単に Application.ScreenUpdating = False の間違いです(´Д⊂

> 再帰というのがいまひとつよくわかりませんでしたが...

【再帰呼び出し】IT用語辞典 e-Words
http://e-words.jp/w/E5868DE5B8B0E591BCE381B3E587BAE38197.html

今回は水平改ページを調整したら、調整前の HPageBreaks コレクションを見て
いても役に立たないのが分かりました。つまり、調整する度に再度頭から水平
改ページを見ていかなくてはなりません。

そのため、全ての水平改ページが調整できるまでサブプロシージャの中で再度
自分自身を呼び出しています。再帰呼び出しは安易につかうと、無限ループに
なりますが、今回のコードでは、blnFlag というフラグが立たなければ終了す
るようになっています。

サブプロシージャの引数 Optional ByVal P As Long の役割は、上からどの
ページまで既に調整したか、、を渡しています。再帰呼び出しされる度に、
また頭から水平改ページを調整し直したのでは効率が悪いので、

　If lngCnt > P Then

として既に調整が終わったページについては空ループさせ、処理速度の向上を
図っています。

> Optional ByVal P As Long？

Optional キーワードは「省略可能な引数」であることを定義しています。
ByVal は「値渡しの引数」であることを定義しています。

【値渡し（引数）IT用語辞典 e-Words
http://e-words.jp/w/E5BC95E695B0.html

お礼

ありがとうございました。
土曜日までご教示いただきほんとうに助かりました。
これで月曜に会社に行くのがちょっと楽しくなりました。

補足

本日、実際のエクセルのブックに実装しました。
完璧です！
ありがとうございました。とても助かりました。
これからもご指導のほど、よろしくお願いいたします。

回答No.6

KenKen_SP

原因は水平改ページを修正することで、元の HPageBreaks コレクション自体が
全然変わってしまうことでした。つまり、調整したら、また最初からやり直さ
ないといけない。

これを水平改ページ調整部分をサブプロシージャにして、再帰することで解決
しています。

今度こそ大丈夫と思われ。m(__)m

Option Explicit

Sub Sample()

　　Dim H　As HPageBreak
　　Dim C　As Range
　　Dim x　As Long

　　With ActiveSheet
　　　　ActiveWindow.View = xlPageBreakPreview
　　　　.ResetAllPageBreaks
　　　　x = .Range("A65536").End(xlUp).Row
　　　　.PageSetup.PrintArea = .Range("A1:G" & CStr(x)).Address
　　　　' 改ページ設定するより先に PrintArea を設定した方が良いかも
　　　　.VPageBreaks.Add Before:=.Cells(2, "H")
　　End With
　　' 水平改ページ調整
　　Call sp_HpageBreaks

End Sub

' 水平改ページ調整サブプロシージャ
Private Sub sp_HpageBreaks(Optional ByVal P As Long)

　　Dim H As HPageBreak, C As Range
　　Dim blnFlag As Boolean
　　Dim lngCnt　As Long

　　Application.ScreenUpdating = True
　　For Each H In ActiveSheet.HPageBreaks
　　　　lngCnt = lngCnt + 1
　　　　If lngCnt > P Then
　　　　　　Set C = Cells(H.Location.Row, "B")
　　　　　　If H.Location.Offset(, 1).Address = C.MergeArea.Cells(2, 1).Address Then
　　　　　　　　Set H.Location = H.Location.MergeArea.Offset(-1)
　　　　　　　　blnFlag = True
　　　　　　　　Exit For
　　　　　　Else
　　　　　　　　Set H.Location = H.Location
　　　　　　End If
　　　　End If
　　Next H
　　Set C = Nothing
　　If blnFlag Then Call sp_HpageBreaks(lngCnt) ' 再帰

End Sub

お礼

ありがとうございました。
Optional ByVal P As Long？
再帰というのがいまひとつよくわかりませんでしたが今度は大丈夫のようです。

Application.ScreenUpdating = Trueがはいっていましたが、画面の更新をとめていると水平改ページ調整サブプロシージャは作動しないのでしょうか？

回答No.5

KenKen_SP

> はい、改ページが何ページにも及ぶと、最後の方の改ページが結合セル内に
> ひかれてしまう場合があります。（何回かに１回ですが）

ということは、タイミングの問題かもしれません。同一データで再現しない
場合があるならその可能性は大です。Wait を入れてみたらどうなりますか？

Excel VBA は、印刷周りの処理速度が遅いです。ループで次々に実行される
命令に Excel が追いついてないのかもしれません。

下記では 0.15 秒で Wait を入れてますが、マシンスペックなどにも依存する
と思いますので、若干の余裕をみて調整してみて下さい。

　# 違うかな？^^;
　# ソースが長くなるので前回までのコメントはカットしてます

Sub Sample()

　　Dim Sh As Worksheet, H As HPageBreak, C　As Range
　　Dim t　As Single
　　Dim x　As Long

　　Set Sh = ActiveSheet
　　With Sh
　　　　ActiveWindow.View = xlPageBreakPreview
　　　　.ResetAllPageBreaks
　　　　x = .Range("A65536").End(xlUp).Row
　　　　.PageSetup.PrintArea = .Range("A1:G" & CStr(x)).Address
　　　　' 改ページ設定するより先に PrintArea を設定した方が良いかも
　　　　.VPageBreaks.Add Before:=.Cells(2, "H")
　　End With
　　For Each H In Sh.HPageBreaks
　　　　Set C = Cells(H.Location.Row, "B")
　　　　If H.Location.Offset(, 1).Address = C.MergeArea.Cells(2, 1).Address Then
　　　　　　Set H.Location = H.Location.MergeArea.Offset(-1)
　　　　Else
　　　　　　Set H.Location = H.Location
　　　　End If
　　　　' Wait してみる
　　　　t = Timer
　　　　Do While Timer < t + 0.15 '0.15秒 Wait
　　　　　　DoEvents
　　　　Loop
　　Next H
　　Set C = Nothing
　　Set Sh = Nothing

End Sub

お礼

なんどもすみません。以下でやりましたが同様です。行の高さ54.75でやった場合、164行目の改ページ位置が取得されませんでした。
Sub Sample2()
Dim Sh As Worksheet, H As HPageBreak, C As Range
Dim t As Single
Dim x As Long
Set Sh = ActiveSheet
With Sh
ActiveWindow.View = xlPageBreakPreview
.ResetAllPageBreaks
x = .Range("A65536").End(xlUp).Row
.PageSetup.PrintArea = .Range("A1:G" & CStr(x)).Address
' 改ページ設定するより先に PrintArea を設定した方が良いかも
.VPageBreaks.Add Before:=.Cells(2, "H")
End With
For Each H In Sh.HPageBreaks
Set C = Cells(H.Location.Row, "B")
C.Offset(0, -1).Interior.ColorIndex = 3
If H.Location.Offset(, 1).Address = C.MergeArea.Cells(2, 1).Address Then
Set H.Location = H.Location.MergeArea.Offset(-1)
Else
Set H.Location = H.Location
End If
' Wait してみる
t = Timer
Do While Timer < t + 0.15 '0.15秒 Wait
DoEvents
Loop
Next H
ActiveWindow.View = xlNormalView
Set C = Nothing
Set Sh = Nothing
End Sub

回答No.4

KenKen_SP

> 何度か試しましたが、行の高さや、余白の位置によって最後の方の結合セル
> 上に改ページが入る場合があるので不思議です。

これは、うまくいかない...という解釈でよろしいですか？

基本的に、Excel が自動で打つ改ページ（改ページビューで点線で表示される
もの）を調整してるだけですから、行高や余白を変更しても再度マクロを実行
すれば対応するはずですが....

> 最後の方の結合セル上に改ページが入る場合がある

というのは、余計な改ページが入るってことですか？ 上記で説明したとおり、
Excel が自動で挿入する水平改ページを上下に操作しているだけで、コードで
任意の場所に水平改ページを挿入しているわけではありません。

つまり、、そんなハズはない、、と思うのですが。。

> C.MergeArea.Cells(2, 1).Address とはどのセルを指すのでしょうか？

　　Set C = Cells(H.Location.Row, "B")

でオブジェクト変数 C は Excel が自動的に打つ改ページ HPageBreak の
Location 行の B 列、、つまり $A$50 に自動改ページが打たれていたら、その
行の B 列、B50セルが参照されてます。

この時 C が結合セルであった場合、MergeArea プロパティーを参照することで
その結合範囲が得られます。例えば B50 が B51 と結合されていたとき、

　　Msgbox Range("B50").MergeArea.Address

で $B$50:$B:$51 と表示されます。

その範囲のCells(2,1）ですから、結合セル範囲の2番目の行、1番目のセルが
返ります。

　　Msgbox Range("B50").MergeArea.Cells(2,1).Address

なら、$B$51 と表示されます。

A49 と A50 の間に水平改ページがある時、HPageBreak の Location が返す
アドレスは $A$50。つまり、点線の改ページの下側のセルです。

それが、結合セルの下側のアドレスと等しければ、結合セルの真ん中で改ページ
されている...と判定させて、結合セルの前に水平改ページを移動させてます。

これは、B 列は行方向に２つのセルが必ず結合されているのが前提になってます。
（表示・非表示は関係なく）

お礼

> これは、うまくいかない...という解釈でよろしいですか？

はい、改ページが何ページにも及ぶと、最後の方の改ページが結合セル内にひかれてしまう場合があります。（何回かに１回ですが）
もちろんマクロを走らせたあとから余白や行の高さを変えてるわけではありません。

> それが、結合セルの下側のアドレスと等しければ、結合セルの真ん中> で改ページされている...と判定させて、結合セルの前に水平改ページを移動させてます。

思ったとおりです。だから不思議なんです。

> B 列は行方向に２つのセルが必ず結合されているのが前提になってます。

1シートに表が上下にいくつもあり、表と表の間に１行の空白行があり、この行には結合セルはないのですが、関係ないですよね？

補足

不思議なので
For Each H In Sh.HPageBreaks
' 結合セルの真ん中に水平改ページが引かれていたら、
' 結合セルの前に直す
Set C = Cells(H.Location.Row, "B")
C.Offset(0, -1).Interior.ColorIndex = 3
If H.Location.Offset(, 1).Address = C.MergeArea.Cells(2, 1).Address Then
Set H.Location = H.Location.MergeArea.Offset(-1)
Else
Set H.Location = H.Location
End If
Next H
と、実際に自動改ページされるＡ列に色を付けてみたところ、Ｂ列が結合セルの２番目の行なのに着色されないで自動改ページされてるところがありました。つまり自動改ページ位置が取得されてないようなのです。

回答No.3

KenKen_SP

再再度 すみません...

あーー。。#2 でもダメですね。3度目の正直で。多分大丈夫なはず。
修正だらけなので、再掲しておきます。

Sub Sample()

　　Dim Sh　 As Worksheet
　　Dim H　　As HPageBreak
　　Dim C　　As Range

　　Set Sh = ActiveSheet
　　With Sh
　　　　.Activate
　　　　' 改ページビュー表示
　　　　ActiveWindow.View = xlPageBreakPreview
　　　　' 印刷改ページ情報初期化
　　　　.ResetAllPageBreaks
　　　　' 垂直改ページ挿入
　　　　.VPageBreaks.Add Before:=.Cells(2, "H")
　　　　' 印刷範囲設定
　　　　.PageSetup.PrintArea = .Range("A2").CurrentRegion.Address
　　End With
　　' 水平改ページ HPageBreakes コレクションを調べる
　　For Each H In Sh.HPageBreaks
　　　　' 結合セルの真ん中に水平改ページが引かれていたら、
　　　　' 結合セルの前に直す
　　　　Set C = Cells(H.Location.Row, "B")
　　　　If H.Location.Offset(, 1).Address = C.MergeArea.Cells(2, 1).Address Then
　　　　　　Set H.Location = H.Location.MergeArea.Offset(-1)
　　　　Else
　　　　　　Set H.Location = H.Location
　　　　End If
　　Next H
　　Set C = Nothing
　　Set Sh = Nothing

End Sub

お礼

せっかくご回答いただいたのに、いまから会社の歓送迎会で外に出ます。
自宅に戻ってから試しますね。
ありがとうございました。

補足

おはようございます。
試してみました。途中空白行（表と表の間の1行）が何箇所かあるので
　.PageSetup.PrintArea = .Range("A2").CurrentRegion.Address
の部分を
x = .Range("A65536").End(xlUp).Row
.PageSetup.PrintArea = .Range("A1:G" & x).Address
と変えて試しました。
何度か試しましたが、行の高さや、余白の位置によって最後の方の結合セル上に改ページが入る場合があるので不思議です。

C.MergeArea.Cells(2, 1).Address とはどのセルを指すのでしょうか？

回答No.2

KenKen_SP

こんにちは。再度 KenKen_SP です。

あーー。。#1 だと、やっぱダメですね。マージン変えたら対応しませんでした。
#1 のコードで一部下記の通り修正します。

結構冗長なコードなので、ご希望に沿うようなら適当に修正して下さい。

' 結合セルの真ん中に水平改ページが引かれていたら、
' 結合セルの前に直す
If H.Location.Address = H.Location.MergeArea.Cells(1, 1).Address Then
　　Set H.Location = H.Location.MergeArea.Offset(-1)
End If

回答No.1

KenKen_SP

こんにちは。KenKen_SP です。

こんな感じでどうでしょうか？ 充分なテストはしてませんが。

Sub Sample()

　　Dim Sh　 As Worksheet
　　Dim H　　As HPageBreak

　　Set Sh = ActiveSheet
　　With Sh
　　　　.Activate
　　　　' 改ページビュー表示
　　　　ActiveWindow.View = xlPageBreakPreview
　　　　' 印刷改ページ情報初期化
　　　　.ResetAllPageBreaks
　　　　' 垂直改ページ挿入
　　　　.VPageBreaks.Add Before:=.Cells(2, "H")
　　　　' 印刷範囲設定
　　　　.PageSetup.PrintArea = .Range("A2").CurrentRegion.Address
　　End With
　　' 水平改ページ HPageBreakes コレクションを調べる
　　For Each H In Sh.HPageBreaks
　　　　' 結合セルの真ん中に水平改ページが引かれていたら、
　　　　' 結合セルの前に直す
　　　　If H.Location.Address = H.Location.MergeArea.Cells(1, 1).Address Then
　　　　　　Set H.Location = H.Location.Offset(-1)
　　　　End If
　　Next H
　　Set Sh = Nothing

End Sub