1

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
2

2 件の回答 2

2

cubik♦さま、kunifさま、コメント頂きありがとうございました。
VBAは初めてで完全に横着して質問をしてしまったのですが、少し勉強して以下のように解決することができました。

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

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

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
1

下記のサンプルコードでも実現できます。

配列に対してループする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

この質問に回答するには、ログインする必要があります。

求めていた回答ではありませんか? のタグが付いた他の質問を参照する。