WordVBAで文書中に特定のフォント色が使われているかチェックする

WordVBAで、何かの処理を実行する前に、特定のフォントカラー（例えば赤色）が使われているかチェックしたい場合があります。
（例えば、その処理で特定の条件に該当する場合に、同じフォントカラーにする処理をする場合は、元々使っていた色と重複すると、処理実行によって
そのフォントカラーになった部分か区別がつかないと困りますよね。）

下記のコードで、文書中に特定のフォントカラーが使われているかチェックを行うことができます。

※noteでの同様の記事をアップロードしています。記事はこちら。

WordVBA

Sub sb赤色のフォントが使われているかチェックする()
    Dim myRange
    Dim foundFlag As Boolean
    foundFlag = False ' フラグを初期化

    ' アクティブドキュメントの全範囲をループ
      Set myRange = ActiveDocument.Range(0, 0)
      With myRange.Find
        .Text = ""
        .Forward = True
        .Font.Color = wdColorRed
        .Wrap = wdFindStop
        .Execute
        If .Found = True Then
            foundFlag = True
        End If
      End With
      
    ' 赤色フォントが見つかった場合にメッセージを表示
    If foundFlag Then
        MsgBox "赤色のフォントが使用されています。", vbInformation
    Else
        MsgBox "赤色のフォントは使用されていません。", vbInformation
    End If
End Sub

別のメイン処理で上記を行いたい場合には、Subプロシージャではなく、Functionでやるとよいと思います。

WordVBA

Function zf赤色のフォントが使われているか(a_doc As Document) As Boolean
'Booleanの初期値はFalseのため、見つからなければFalseを返す
    Dim myRange
    
    'アクティブドキュメントの全範囲を検索
    Set myRange = ActiveDocument.Range(0, 0)
    With myRange.Find
      .Text = ""
      .Forward = True
      .Font.Color = wdColorRed
      .Wrap = wdFindStop
      .Execute
      If .Found = True Then
          zf赤色のフォントが使われているか = True
      End If
    End With
    
End Function

その上で、使用しているフォントカラーを一時的に別の色に変更したいという場合は、下記をご利用ください。
なお、データ型をWdColor型にしてフォントカラーを指定していますが、データ型をLong型へ変更してRGBで指定することも可能です。

WordVBA

Sub sbテキストカラーを赤からスカイブルーへ変更()
    Call sbテキストカラー変更(ActiveDocument, wdColorRed, wdColorSkyBlue)
    Dim myMsg As String 'メッセージボックス用変数
    myMsg = "処理が終了しました。"
    MsgBox myMsg, , "処理結果通知"
End Sub

Sub sbテキストカラー変更(ByVal a_doc As Document, ByRef a_beforeColor As WdColor, ByRef a_afterColor As WdColor)
    Dim myRange
    Set myRange = a_doc.Content
    Call sbSetting(True)  '画面更新OFF等の初期設定ON

    With myRange
        .Find.Font.Color = a_beforeColor
        .Find.Replacement.Font.Color = a_afterColor
        .Find.Execute Replace:=2
    End With
    
    ' 終了処理
    Set myRange = Nothing
    Call sbSetting(False) '画面更新OFF等の初期設定OFF
End Sub

Public Sub sbSetting(flg As Boolean)
  If flg Then
    Application.ScreenUpdating = False                  '画面更新の停止
    Application.DisplayAlerts = False                   '画面警告の表示の停止
  Else
    Application.ScreenUpdating = True                   '画面更新の開始
    Application.DisplayAlerts = True                    '画面警告の表示の開始
  End If
End Sub