業務で使えそうなマクロを作成したのでメモ
Sub Font_Change() 'フォントの種類別一括変換
Dim doc_all As String
Dim doc As Range
Dim k As Long
With ActiveDocument
doc_all = .Range(0, .Bookmarks("\EndOfDoc").End)
End With
For k = 1 To Len(doc_all)
Set doc = ActiveDocument.Range(k - 1, k)
If doc.Font.Name = "Cambria Math" Then '数式用のフォントを確認
ElseIf doc.Text Like "[^ぁ-んァ-ヶ一-龠〃々〆〇｡-ﾟ]" Then '日本語識別
doc.Font.Name = "ＭＳ 明朝 (本文のフォント - 日本語)" '日本語フォント
ElseIf doc.Text Like "[A-Za-zＡ-Ｚａ-ｚ]" Then '英語識別
doc.Font.Name = "Century (本文のフォント)" '英語フォント
Else: doc.Font.Name = "ＭＳ 明朝 (本文のフォント - 日本語)" 'その他のフォント
End If
Next
End Sub