Word文書内の複数の文字列をイタリックに変換する方法を探しております。  
例えばword文書内に

```

    文字列1
    文字列2
    文字列1
    文字列3
    ・
    ・
    ・
    
```

とある場合に、"文字列1"のみであれば、以下のWordVBAのコードで変換できるのですが、複数単語（"文字列2"，"文字列3"のように）でもイタリックに変換できるようなコードを書きたいと思っております。  
方法をお教えいただけますと幸いです。  
何卒よろしくお願い申し上げます。

```

    Sub findText()
    
    With Selection.Find
        .Text = "文字列1"
        Do While .Execute
            Selection.Font.Italic = True
        Loop
    End With
    
    End Sub
    
```
CC BY-SA 4.0
2021-06-29T06:54:15.047
77849
2021-06-30T07:43:13.747
2021-06-29T07:01:46.540
2238
47088
question
vba ms-word
Word文書内の複数の文字列をイタリックに変換する方法
cubik♦さま、kunifさま、コメント頂きありがとうございました。  
VBAは初めてで完全に横着して質問をしてしまったのですが、少し勉強して以下のように解決することができました。

斜体にしたい文字列のレコードをcsvで作成し、VBA上でcsvファイルの参照・一致を確認・イタリックに置換の3ステップを経ました。

なお、list.csvの中身は、1列目に"文字列１"、"文字列２"、"文字列３"を記載したものとなっております。もう少しやり方があるのかもしれませんが、目的は一旦達成しました。

```

    Sub 斜体変換()
    
        '参照元のcsvファイルを開く
        Open "list.csv" For Input As #1
        While Not EOF(1)
        Line Input #1, a
        s = Split(a, ",")
        MsgBox s(0) & " " & s(0)
        'イタリックに変換したい変数Targetの宣言
        Dim Target As String
        
        '文書の先頭を選択
        ActiveDocument.Range(0, 0).Select
        
        'Targetにcsvファイルの1列目を指定
        Target = s(0)
        
        '条件クリア
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        
        '斜体設定
        Selection.Find.Replacement.Font.Italic = True
        
        '斜体変換を実行
    With Selection.Find
        .Text = Target
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = True
        .Execute Replace:=wdReplaceAll
      End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Wend
    Close #1
    End Sub
    
```
CC BY-SA 4.0
2021-06-30T06:52:34.940
77876
2021-06-30T07:33:32.133
2021-06-30T07:33:32.133
3060
47088
77849
answer
下記のサンプルコードでも実現できます。

配列に対してループする`findArray`関数と、正規表現マッチに対してループする`findRegexp`です。  
どちらもカーソルで選択中の範囲内の指定文字列を斜体に変更します。

考え方自体はコメントの通りなのですが、単純にループすることで実現できるかと思いきや案外つまづくポイントがありました。  
ポイントはサンプルコードのコメントに記載しました。

**サンプルコード**

```

    '多重ループ
    Sub findArray()
        '検索対象の定義
        Dim words(3) As String
        words(0) = "文字列1" 
        words(1) = "文字列2" 
        words(2) = "文字列3" 
    
        Dim selRange As Range
        For Each w In words
            Set selRange = Selection.Range.Duplicate        'ループ開始時に選択範囲をDuplicateしておく ※しておかないと選択範囲がクリアされて"文字列2"以降が選択できない
            selRange.Find.Text = w
            Do While selRange.Find.Execute
                If selRange.InRange(Selection.Range) Then   '選択範囲の終端より前のみ対象とする ※このIf文がないとカーソル選択範囲の後ろまで処理を継続する
                    selRange.Italic = True
                End If
            Loop
        Next
    End Sub
    
    '正規表現
    Sub findRegexp()
        '事前バインディング: Microsoft VBScript Regular Expressions
        'Dim re As New RegExp
        '遅延バインディング
        Dim re As Object
        Set re = CreateObject("VBScript.RegExp")
    
        re.Pattern = "文字列1|文字列2|文字列3" 
        re.Global = True                                 'マッチ対象をすべて取得 ※しないと1文字しか対象にできない
    
        Dim start As Integer
        For Each m In re.Execute(Selection)
            start = Selection.start + m.FirstIndex       '選択開始位置 + 選択範囲内でヒットした相対位置
            Range(start, start + m.Length).Italic = True
        Next
    End Sub
    
```
CC BY-SA 4.0
2021-06-30T07:43:13.747
77879
2021-06-30T07:43:13.747
9820
77849
answer