【Word VBA】書式を検索すると永久ループしてしまう場合

Word VBA のプログラミングで、書式を検索してループ処理していくコードを書いて実行すると、なぜか原因不明の永久ループになってしまったという経験は無いでしょうか？
たとえば次のコードは、Word 文書上の太字の文字を赤字にして、処理が終わったら「終了」と表示するコードです。

Sub a1()

Dim oRange As Range
Set oRange = ActiveDocument.Range
Dim oFind As Find
Set oFind = oRange.Find
oFind.ClearFormatting
oFind.Format = True
oFind.Font.Bold = True '太字を検索
oFind.Forward = True
Do While oFind.Execute = True
    oRange.Font.ColorIndex = wdRed
    Call oRange.SetRange(oRange.End, oRange.End)
Loop
MsgBox "終了"

End Sub

ほとんどの場合、上記のコードは正常に動作しますが、稀に永久ループになってしまい処理が終わらないことがあります。
太字の文字がもう文書上には見つからないにも関わらず、oFind.Execute が True を返し続けるからです。
これは文書にバグが含まれている場合に起きる現象と考えられます。

私は色々と試した結果、コードを下記のように修正することでこの問題を回避できました。

Sub a2()

Dim oRange As Range
Set oRange = ActiveDocument.Range
Dim oFind As Find
Set oFind = oRange.Find
oFind.ClearFormatting
oFind.MatchWildcards = True 'ワイルドカード検索
oFind.Text = "?" '1文字検索
oFind.Format = True
oFind.Font.Bold = True '太字を検索
oFind.Forward = True
Do While oFind.Execute = True
    Call oRange.SetRange(oRange.Start, oRange.Start) '太字1文字が見つかったらその直前に検索位置を戻す
    oFind.MatchWildcards = False 'ワイルドカード検索をオフ
    oFind.Text = "" 'テキスト指定をしない
    oFind.Execute '太字を再検索。連続する1文字以上の太字にヒットする

    oRange.Font.ColorIndex = wdRed
    Call oRange.SetRange(oRange.End, oRange.End)

    oFind.MatchWildcards = True 'ワイルドカード検索に戻す
    oFind.Text = "?" '1文字検索
Loop
MsgBox "終了"

End Sub

前述の不具合が起きる場合、テキストをワイルドカードで指定した上で書式検索するとその不具合をなぜか回避できます。

ワイルドカード＋書式指定で検索がヒットしたら、検索位置を戻して再び（ワイルドカードを使わない）通常の書式検索をすると、正常に処理できます。

ちなみに前述の 2 つのコードは、Range.Find を使用したやり方ですが、Selection.Find を使用する場合は下記のようになります。

Sub a3()

Dim oRange As Range
Set oRange = ActiveDocument.Range
Dim oFind As Find
Set oFind = Selection.Find
oFind.ClearFormatting
oFind.MatchFuzzy = False 'Selection.Find の場合はこれをしておかないとエラーになる
oFind.MatchWildcards = True 'ワイルドカード検索
oFind.Text = "?" '1文字検索
oFind.Format = True
oFind.Font.Bold = True '太字を検索
oFind.Forward = True
Do While oFind.Execute = True
    Selection.MoveLeft '太字1文字が見つかったらその直前に検索位置を戻す
    oFind.MatchWildcards = False 'ワイルドカード検索をオフ
    oFind.Text = "" 'テキスト指定をしない
    oFind.Execute '太字を再検索。連続する1文字以上の太字にヒットする

    Selection.Font.ColorIndex = wdRed
    Selection.MoveRight

    oFind.MatchWildcards = True 'ワイルドカード検索に戻す
    oFind.Text = "?" '1文字検索
Loop
MsgBox "終了"

End Sub