リストを元に連続して置換
Wordで文書を編集しているときに、用語を統一したいときがあります。
例えば「エディター」を「エディタ」に揃えるような場合です。
置換機能を使えば簡単なのですが、対象となる用語が大量にある場合にはちょっと面倒です。
そこで変換用のリストを作っておき、それを元に連続して文字列を置換するマクロを作ってみました。
リスト
Wordの本文に次のようなリストを書いておきます。
置換前と置換後の文字列を並べ、セミコロン(;)で区切ります。
セミコロンのない行は無視されるので注釈などを書いておいてもかまいません。
エディター;エディタ
プリンター;プリンタ
サーバー;サーバ
プリンター;プリンタ
サーバー;サーバ
コード
次のコードを使います。
マクロを実行すると用語を統一したい文書ファイルを選ぶダイアログが出ます。
ファイルを選択するとそのファイルが開き、リストに従って次々に置換が実行されます。
Sub リストを元に連続して置換()
Dim mae(100)
Dim ato(100)
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "ファイルを選択"
.AllowMultiSelect = False
.Show
filename = .SelectedItems(1)
End With
Set paras = ActiveDocument.Paragraphs
x = 0
For i = 1 To paras.Count
line = paras(i).Range.Text
temp = Split(line, ";")
If UBound(temp) > 0 Then
mae(x) = temp(0)
ato(x) = replace(temp(1), Chr(13), "")
x = x + 1
End If
Next i
Documents.Open filename:=filename
For i = 0 To x - 1
Set myRange = ActiveDocument.Range(Start:=0, End:=0)
With myRange.find
.ClearFormatting
.Text = mae(i)
With .Replacement
.ClearFormatting
.Text = ato(i)
End With
.Execute replace:=wdReplaceAll
End With
Next i
End Sub
Dim mae(100)
Dim ato(100)
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "ファイルを選択"
.AllowMultiSelect = False
.Show
filename = .SelectedItems(1)
End With
Set paras = ActiveDocument.Paragraphs
x = 0
For i = 1 To paras.Count
line = paras(i).Range.Text
temp = Split(line, ";")
If UBound(temp) > 0 Then
mae(x) = temp(0)
ato(x) = replace(temp(1), Chr(13), "")
x = x + 1
End If
Next i
Documents.Open filename:=filename
For i = 0 To x - 1
Set myRange = ActiveDocument.Range(Start:=0, End:=0)
With myRange.find
.ClearFormatting
.Text = mae(i)
With .Replacement
.ClearFormatting
.Text = ato(i)
End With
.Execute replace:=wdReplaceAll
End With
Next i
End Sub
最近のコメント