こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

投稿日時 - 2006-07-07 15:06:48

QNo.2261261

困ってます

質問者が選んだベストアンサー

> 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

投稿日時 - 2006-07-08 22:39:24

補足

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

投稿日時 - 2006-07-10 16:25:19

お礼

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

投稿日時 - 2006-07-08 23:15:36

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.6

原因は水平改ページを修正することで、元の 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

投稿日時 - 2006-07-08 19:14:07

お礼

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

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

投稿日時 - 2006-07-08 21:45:54

ANo.5

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

ということは、タイミングの問題かもしれません。同一データで再現しない
場合があるならその可能性は大です。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

投稿日時 - 2006-07-08 16:50:38

お礼

なんどもすみません。以下でやりましたが同様です。行の高さ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

投稿日時 - 2006-07-08 17:33:15

ANo.4

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

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

基本的に、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 列は行方向に2つのセルが必ず結合されているのが前提になってます。
(表示・非表示は関係なく)

投稿日時 - 2006-07-08 11:59:03

補足

不思議なので
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
と、実際に自動改ページされるA列に色を付けてみたところ、B列が結合セルの2番目の行なのに着色されないで自動改ページされてるところがありました。つまり自動改ページ位置が取得されてないようなのです。

投稿日時 - 2006-07-08 16:29:32

お礼

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

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

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

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

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

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

投稿日時 - 2006-07-08 15:26:37

ANo.3

再再度 すみません...

あーー。。#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

投稿日時 - 2006-07-07 16:51:11

補足

おはようございます。
試してみました。途中空白行(表と表の間の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 とはどのセルを指すのでしょうか?

投稿日時 - 2006-07-08 10:25:37

お礼

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

投稿日時 - 2006-07-07 17:39:24

ANo.2

こんにちは。再度 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

投稿日時 - 2006-07-07 16:37:22

ANo.1

こんにちは。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

投稿日時 - 2006-07-07 16:26:22

あなたにオススメの質問