ワードで複数の文字を一括・連続置換するマクロ

質問

ワード（Word）で複数の文字を一括・連続置換するマクロを作りたいのです。
次の回答を参考にしてマクロを作ってみました。
http://oshiete1.goo.ne.jp/kotaeru.php3?q=994495

ところが、置換したい単語が100くらいになってきて扱いづらいので、
ワード（又はテキストやエクセルでも可）の置換文字のリストのファイルを参照して、同じように連続置換させたいのですが、どのような方法があるでしょうか？

シェアウェアでも同様の機能をもつものがありますが、自由にカスタマイズできないので使えません。
（置換後の文字列に蛍光ペンをかけたいので）

回答No.2

imogasi · ベストアンサー

過去質問に回答が出ている者です。
ファイルのもっとも原始的なものはテキストファイルです。
この際はCSVファイルを使います。
ワードの文章に
名称　関東大会
開催地　東京都
時刻　　１時
参加　　小学生
とあるとして
メモ帳に
関東,東北
東京都,宮城県
小学,中学
１時,２時半
のようなのを（実際例では１００行ばかり）作り、名前をつけて保存します。
各行の、各ペアーはカンマの左を、右の語句で置き換えるつもりです。
この場合は「置換2.csv」にしてます。
VBEの標準モジュールに
Sub test06()
Open "置換2.csv" For Input As #1
While Not EOF(1)
Line Input #1, a
s = Split(a, ",")
MsgBox s(0) & " " & s(1)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = s(0)
.Replacement.Text = s(1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Wend
Close #1
End Sub
を貼り付け実行します。
結果
名称　東北大会
開催地　宮城県
時刻　　２時半
参加　　中学生
ただ注意事項は
東京都と東京など１部共通語があるときは語数が長いほうを、CSVファイルの先に置くこと。
先に出現の語で変換後、後出の語に当てはまり、後出のペアーで変換されて、うまく思い通りに行かない場合があるかもしれないので、ロジック的に難しい面を含んでいるように推測するが、普通のケースでは使えるように思う。

お礼

ありがとうございます！！
VBAは素人ですが、見よう見まねで少しいじってみました。
変更履歴をONにするために、次の文を追加して、
With ActiveDocument
.TrackRevisions = True
.ShowRevisions = True
CommandBars("Reviewing").Visible = True
End With

置換語のダイアログは隠すようにしました。
'MsgBox s(0) & " " & s(1)

ちなみに、Openのファイルのパスの設定がよく分からないので、とりあえず"c:\置換2.csv"にしたらうまくいきました。
「取扱い注意＝OK」「取（り）扱います＝NG」のようなものは、置換よりもコメント付与でチェックするなどの工夫が必要。
自分のイメージに近いものが出来上がりそうです。ありがとうございました！

回答No.1

hirumin

単にテキストの文字列置換であれば、「Speeeeed」というフリーソフトはいかがでしょう。（参考URL）
私も実際に使用していましたが、動作も快適だと思います。
宜しければ試してみて下さい。

参考URL：

http://akky.cjb.net/download/index.html

お礼

ありがとうございます。Speeeeedは気になっていましたが、既に書式やレイアウトが完成しているワード文書を置換して、変更履歴で確認したいのでNGなのです。