Help us understand the problem. What is going on with this article?

Word VBA | 選択範囲内で置換

More than 1 year has passed since last update.

やりたいこと

Word VBAで検索、置換を自動化するには、Findオブジェクトを使った方法が知られています。

Word VBAで文字列を置換する方法!いくつかの基本パターンを徹底解説

この方法は、Wordの仕様で、文章全体、上方向、下方向のいずれかしか検索、置換できません。つまり、選択範囲内の文章だけを対象にして検索、置換できないことが不便です。そこで、選択された文章を対象にして、置換を行うVBAコードを作りました。

単純な置換

一番簡単な方法 (Findオブジェクトの利用)

下記のコードの、"検索したい単語"、"置換したい単語"を実際に検索したい単語と置換したい単語に置き換えれば使用できます。
こちらは、Wordに標準搭載されている検索機能を使うVBAのため、最も簡単です。

Module1
'選択範囲内で置換
Public Sub replaceInSelected()
    Dim strSearch As String, strRep As String
    Dim rng As Range
    Set rng = Selection.Range
    strSearch = "検索したい単語"
    strRep = "置換したい単語"

    rng.Collapse wdCollapseStart
    Do
        With rng.Find
            .ClearFormatting
            .Text = strSearch
            .Execute Replacewith:=strRep, Replace:=wdReplaceOne
            If .Found = False Then Exit Do
        End With
        If rng.End > Selection.Range.End Then Exit Do 'エラー回避
        Set rng = ActiveDocument.Range(rng.End, Selection.Range.End)
    Loop

End Sub

もう一つの方法 (RegExpオブジェクトの利用)

ちなみに、正規表現をWordで取り扱うためのRegExpオブジェクトを使用しても同じことができます。
こちらは、Wordの標準機能でないため、CreateObjectでVBScriptのRegExpオブジェクトを呼び出して使用します。
Findオブジェクトより癖がないので、使いやすい反面、String型でデータを渡しているので、書式が消えてしまうのがデメリットです。

Module2
'選択範囲内で置換-2
Public Sub replaceInSelected2()
    Dim strSearch As String, strRep As String
    strSearch = "検索したい単語"
    strRep = "置換したい単語"

    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    With re
        .Pattern = strSearch
        .ignorecase = False
        .Global = True
        Selection.Range.Text = .Replace(Selection.Range.Text, strRep)
    End With

End Sub

書式の置換

太字の単語にアンダーラインを付ける場合のマクロです。書式を変更する場合は、Findオブジェクトの方がはるかに簡単です。

Module3
'選択範囲内で書式の置換
Public Sub replaceInSelected3()
    Dim rng As Range
    Set rng = Selection.Range

    rng.Collapse wdCollapseStart
    Do
        With rng.Find
            .ClearFormatting
            .Font.Bold = True
            With .Replacement
                .ClearFormatting
                .Font.Underline = wdUnderlineThick
            End With
            .Execute Format:=True, Replace:=wdReplaceOne
            If .Found = False Then Exit Do
        End With
        If rng.End > Selection.Range.End Then Exit Do
        Set rng = ActiveDocument.Range(rng.End, Selection.Range.End)
    Loop

End Sub

参考

Umaremin
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした