Sub Macro1()
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="<[a-z]{3}[A-Z]{1}>", MatchWildcards:=True)
            oRng.Select
            If MsgBox("Replace?", vbYesNo) = vbYes Then
                oRng.Font.Italic = True
                oRng.Characters.Last.Font.Italic = False
            End If
            oRng.Collapse 0
        Loop
    End With
    Set oRng = Nothing
End Sub