Sub FormatText()
 
  With AutoCorrect
    .CorrectInitialCaps = True
    .CorrectSentenceCaps = True
    .CorrectDays = True
    .CorrectCapsLock = True
    .ReplaceText = True
    .ReplaceTextFromSpellingChecker = True
    .CorrectKeyboardSetting = False
    .DisplayAutoCorrectOptions = True
    .CorrectTableCells = True
  End With
 
  With Options
    .AutoFormatApplyHeadings = True
    .AutoFormatApplyLists = True
    .AutoFormatApplyBulletedLists = True
    .AutoFormatApplyOtherParas = True
    .AutoFormatReplaceQuotes = True
    .AutoFormatReplaceSymbols = False
    .AutoFormatReplaceOrdinals = False
    .AutoFormatReplaceFractions = False
    .AutoFormatReplacePlainTextEmphasis = False
    .AutoFormatReplaceHyperlinks = True
    .AutoFormatPreserveStyles = True
    .AutoFormatPlainTextWordMail = True
  End With
 
  ActiveDocument.Range.Style = "Normal"
  ActiveDocument.Kind = wdDocumentNotSpecified
  ActiveDocument.Range.AutoFormat
 
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Style = ActiveDocument.Styles("Emphasis")
    .Text = "\(*\)"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
 
    .Text = ""
    .Replacement.ClearFormatting
    .Style = ActiveDocument.Styles("Body Text")
    .Replacement.Style = ActiveDocument.Styles("List Number")
    .Execute Replace:=wdReplaceAll
  End With
 
End Sub