Sub subSeveralFailedAttemps()
'
' Changes all bold formatting in the open document named Example.doc to italic formatting.
' http://www.java2s.com/Code/VBA-Excel...formatting.htm
'
Dim strActiveDocFullName As String
Dim strActiveDocName As String
ActiveDocument.ActiveWindow.SetFocus
strActiveDocFullName = ActiveDocument.FullName
strActiveDocName = ActiveDocument.Name
Dim objDoc As Document
Set objDoc = ActiveDocument
Dim objRange As Range
Set objRange = objDoc.Range
Dim intPosition As Long
objRange.Find.Highlight = True
objRange.Find.Forward = True
Do While objRange.Find.Execute
 If objRange.HighlightColorIndex = wdYellow Then
  objRange.Expand Unit:=wdParagraph
  objRange.Copy
 End If
 intPosition = objRange.End
 objRange.Start = intPosition
Loop ' Do While objRange.Find.Execute
' With Documents(strActiveDocName).Content.Find
' .ClearFormatting
' .Highlight = True
' With .Replacement
' .Highlight = True
' End With
' .Execute FindText:="", ReplaceWith:="", _
' Format:=True, Replace:=wdReplaceAll
' If .Found = True Then
' .Parent.Expand Unit:=wdParagraph
' .Parent.Copy
' .Parent.Font.Bold = False
' End If
' End With
'
End Sub ' subSeveralFailedAttemps()