Maybe :
Sub Test()
Const wdReplaceNone = 0
Const wdReplaceOne = 1
Const wdReplaceAll = 2
Dim objApp As Object, objDoc As Object
Set objApp = CreateObject("Word.Application")
Set objDoc = objApp.Documents.Open(ThisWorkbook.Path & "\MyWordDoc.doc")
With objDoc.Content.Find
.ClearFormatting
With .Replacement
.ClearFormatting
.Font.Color = vbRed
End With
'.Execute FindText:="*", ReplaceWith:="*", Format:=True, Replace:=wdReplaceAll
.Execute FindText:="*", Format:=True, Replace:=wdReplaceAll
End With
objDoc.Close True
objApp.Quit
End Sub
Bookmarks