Sub CStyle()

    Dim objDoc As Document
    Dim cbolditalic As Style
    Set objDoc = ActiveDocument

    Set cbolditalic = ActiveDocument.Styles.Add("*italic", Type:=WdStyleType.wdStyleTypeCharacter)
    With cbolditalic.Font
        .Name = "Times New Roman"
        .Bold = False
        .italic = True
        .Subscript = False
        .Superscript = False

    End With

    Dim rngStory As Range
    For Each rngStory In ActiveDocument.StoryRanges

        Application.ScreenUpdating = False
        With ActiveDocument.Range
            With rngStory.Find

                Options.DefaultHighlightColorIndex = wdYellow
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = ""
                .Replacement.Text = ""
                .MatchWildcards = True
                .Format = True
                .Forward = True
                .Wrap = wdFindContinue

                .Font.Bold = False
                .Font.italic = True
                .Font.Subscript = False
                .Font.Superscript = False
                .Replacement.Style = "*italic"
                .Replacement.Highlight = True
                .Execute Replace:=wdReplaceAll


            End With
        End With
    Next rngStory
    Application.ScreenUpdating = True
End Sub