上書き翻訳などで利用するための一括置換の支援マクロ「ぱらぱら 」のユーザーの方から、「ページで範囲を指定して置換をすることができますか」と質問をいただきました。
ぱらぱらの場合、置換対象範囲をページで指定することはできません。
ただし、蛍光ペンやフォントの色で指定することができます。詳細は、こちらでご確認ください。
置換対象をページ指定する方法について気になったので調べてみました。
簡単なマクロを紹介します。
このマクロでできること
マクロを実行するとページ番号を入力するダイアログボックスが表示されます。
数字を入力してください。
指定したページ内の語句を一括置換します。
マクロの解説
ページの範囲設定の方法がいくつか考えられたため、2つの方法で書きました。
マクロ１
12行目と15行目に設定しました。GoToメソッドで移動した結果をRangeオブジェクトに設定します。
さらに、ここからまたGoToメソッドを使ってページ全体を範囲に再設定しています。
このGoToメソッドの考え方は、Microsoft Excel MVPのインストラクターのネタ帳の伊藤さん の記事「ページを削除するWordマクロ 」に記載されています。
つまり、カーソルを特定ページにジャンプさせるダイアログボックス（Ctrl + G）で、［ページ番号］欄に、\page と入力すると現在ページ全体が選択されるというものです。
範囲を指定したら、あとは置換をするだけです。サンプルのマクロでは、「ワードマクロ」を「Wordマクロ」に置換しています。
マクロ２
こちらも、2ステップです。
最初に指定したページにカーソルを移動させます。
次に使うBookmarksのプロパティが、Selectionオブジェクトにしか対応していないため、Selectメソッドにて、実際にカーソルを移動しています。
Set myRange = Selection.Bookmarks(“\page”).Range
にて、カーソルがあるページ全体をRangeオブジェクトに設定します。
マクロ１
Sub 指定したページ内で置換する1()
Dim myRange As Range
Dim myPageNum As String
Do
myPageNum = InputBox("ページ番号を入力して下さい。")
If myPageNum = vbNullString Then Exit Sub
Loop While IsNumeric(myPageNum) = False
'ページの先頭にRangeオブジェクトを設定
Set myRange = ActiveDocument.GoTo(What:=wdGoToPage, Name:=myPageNum)
'Rangeオブジェクトのあるページ全体を範囲に再設定
Set myRange = myRange.GoTo(What:=wdGoToBookmark, Name:="\page")
With myRange.Find
.Text = "ワードマクロ"
.Replacement.Text = "Wordマクロ"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Set myRange = Nothing
End Sub
マクロ２
Sub 指定したページ内で置換する2()
Dim myRange As Range
Dim myPageNum As String
Do
myPageNum = InputBox("ページ番号を入力して下さい。")
If myPageNum = vbNullString Then Exit Sub
Loop While IsNumeric(myPageNum) = False
'ページ先頭へ移動しカーソル位置を設定
ActiveDocument.GoTo(What:=wdGoToPage, Name:=myPageNum).Select
'カーソル位置のページをRangeオブジェクトの範囲に設定
Set myRange = Selection.Bookmarks("\page").Range
With myRange.Find
.Text = "ワードマクロ"
.Replacement.Text = "Wordマクロ"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Set myRange = Nothing
End Sub
