View Single Post
 
Old 02-11-2015, 10:59 PM
Guessed's Avatar
Guessed Guessed is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,977
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Based on your provided sample, the following macro would do it all. You may also need to modify the character style 'Emphasis' to get it to look blue.
Code:
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
And you also should edit the Heading 1 style to get those headings to your desired look too.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote