Word VBA 検索＆処理の繰り返し

大きなワードの表が1つあり、市章村別に分けて図やらコメントを入れています。市町村名の行は全体に塗りつぶししています。問題は市町村名の行がページの最終行になり、その市町村の図やコメントが次ページになっている場合があり見えにくいのです。そこで、検索した塗りつぶし行のページ番号と次の行のページ番号が違う場合には、塗りつぶし行のところで改行する以下の様なプログラムを本やインターネットを参考にしながら作りました。しかし、最初の塗りつぶし行は正しく改行処理されましたが、エラーも出ず、終了してしまいます。　改行されることにより、表数が増えることが問題なのでしょうか？ご指摘よろしくお願いします。また他の方法で対処できますでしょうか？　よろしくお願いします。

Sub 検索して改ページを挿入()
'
'
Dim myTable As Table
Dim myCell As Cell
Dim mypage1 As Integer
Dim mypage2 As Integer
Dim i As Integer


Application.ScreenUpdating = False

For Each myTable In ActiveDocument.Tables
If myTable.Uniform = False Then
For i = 1 To myTable.Rows.Count

If myTable.Cell(i, 1).Shading.BackgroundPatternColor = -603930625 Then
Set myCell = myTable.Cell(i, 1)
myCell.Select
mypage1 = Selection.Information(wdActiveEndAdjustedPageNumber)
Selection.MoveDown Unit:=wdLine, Count:=1
mypage2 = Selection.Information(wdActiveEndAdjustedPageNumber)
If mypage1 <> mypage2 Then
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak
End If
End If
Next
End If
Next

Application.ScreenUpdating = True
End Sub

No.1 ベストアンサー 回答者： enunokokoro 回答日時： 2020/04/17 19:22

無理やり改ページ（wdPageBreak）を入れる方法は、その位置よりも

前の行などで編集した結果で行数が増えた場合に問題になります。
その行が、常にページ先頭で開始する設定をするのであれば問題は
ないですが、質問文を読む限りだと市町村の行の位置はページ内で
変動しますよね

今回のような場合だと、ページの最終行へと市町村の行がくる場合
のみ行を改ページするようにしたいだけならば、段落書式で設定する
[改ページ位置の自動修正]を使うべきです。
https://ameblo.jp/gidgeerock/entry-11492078801.h …

マクロは未検証ですが、以下のようにしてみては。

Sub 検索して改ページを挿入()
'
'
Dim myTable As Table
Dim myCell As Cell
Dim i As Integer


Application.ScreenUpdating = False

　For Each myTable In ActiveDocument.Tables
　　If myTable.Uniform = False Then
　　　For i = 1 To myTable.Rows.Count

　　　　If myTable.Cell(i, 1).Shading.BackgroundPatternColor = -603930625 Then
　　　　　Set myCell = myTable.Cell(i, 1)
　　　　　myCell.Range.ParagraphFormat.KeepWithNext = True
　　　　End If
　　　Next
　　End If
　Next

Application.ScreenUpdating = True
End Sub

この回答へのお礼

早速ご連絡ご指導いただきありがとうございます。早速マクロの検証をしたところ、希望通りの結果が得られました。改ページを入れなければ、表は1つで、他のマクロにも転用できます。本当にありがとうございます。ベストアンサーに選ばせて頂きます。

お礼日時：2020/04/17 20:48