【コード】指定したページ内で置換をするWordマクロ

上書き翻訳などで利用するための一括置換の支援マクロ「ぱらぱら 」のユーザーの方から、「ページで範囲を指定して置換をすることができますか」と質問をいただきました。

ぱらぱらの場合、置換対象範囲をページで指定することはできません

ただし、蛍光ペンやフォントの色で指定することができます。詳細は、こちらでご確認ください。

ぱらぱら 特定の箇所だけを置換する

置換対象をページ指定する方法について気になったので調べてみました。
簡単なマクロを紹介します。

このマクロでできること

マクロを実行するとページ番号を入力するダイアログボックスが表示されます。
数字を入力してください。

指定したページ内の語句を一括置換します。

マクロの解説

ページの範囲設定の方法がいくつか考えられたため、2つの方法で書きました。

マクロ1

12行目と15行目に設定しました。GoToメソッドで移動した結果をRangeオブジェクトに設定します。

さらに、ここからまたGoToメソッドを使ってページ全体を範囲に再設定しています。

このGoToメソッドの考え方は、Microsoft Excel MVPのインストラクターのネタ帳の伊藤さん の記事「ページを削除するWordマクロ 」に記載されています。

つまり、カーソルを特定ページにジャンプさせるダイアログボックス(Ctrl + G)で、[ページ番号]欄に、\page と入力すると現在ページ全体が選択されるというものです。

範囲を指定したら、あとは置換をするだけです。サンプルのマクロでは、「ワードマクロ」を「Wordマクロ」に置換しています。

マクロ2

こちらも、2ステップです。

最初に指定したページにカーソルを移動させます。

次に使うBookmarksのプロパティが、Selectionオブジェクトにしか対応していないため、Selectメソッドにて、実際にカーソルを移動しています。

Set myRange = Selection.Bookmarks(“\page”).Range

にて、カーソルがあるページ全体をRangeオブジェクトに設定します。

マクロ1


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

マクロ2


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

トップへ戻る