Sub FlareOutputClean()
'
' FlareOutputClean Macro
' Automatically performs some basic cleaning functions on documents created by MadCap Flare's Word Output

Dim objDoc As Document
Set objDoc = ActiveDocument

Dim tempRange As Range

'Application.ScreenUpdating = False

'Dim objShape As InlineShape

'
'DOES NOT WORK, DISABLED: Automatically embeds all images into document
'
'    For Each objShape In objDoc.InlineShapes
'        objShape.LinkFormat.SavePictureWithDocument = True
'    Next objShape

'Fix document title wrapping
objDoc.ActiveWindow.Selection.HomeKey Unit:=wdStory, Extend:=wdMove

    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(-0.5)
    End With
    With Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0.5)
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
    End With
    With Selection.ParagraphFormat
        .SpaceBeforeAuto = False
        .SpaceAfterAuto = False
        .FirstLineIndent = InchesToPoints(0)
    End With

'
' Automatically fixes Note: and Caution: autonumbering for Flare Word Output docs.
'
    objDoc.Range.Select
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "C: {b}Caution: {/b}"
        .Replacement.Text = "Caution:^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find
        .Text = "N: {b}Note{/b}:"
        .Replacement.Text = "Note:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    '
    'Automatically repairs errors with cross references. The search is performed by link color to avoid false positives.
    '
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = 16748574
    Selection.Find.Replacement.ClearFormatting

    'Add a space after quotes. Extra spaces will be added but cleaned up later.
    With Selection.Find
        .Text = """"
        .Replacement.Text = """ "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Extra spaces added above are removed, along with an extra space that existed previous to macro execution
    With Selection.Find
        .Text = """  "
        .Replacement.Text = """"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Extra space between the auto-number and heading text is removed
    With Selection.Find
        .Text = ":  "
        .Replacement.Text = ": "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Stray error message caused by cross-references that do not have an auto-number is removed.
    With Selection.Find
        .Text = " UNRESOLVED CROSS-REFERENCE "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    '
    'Properly colors page reference portion of cross references
    '

    'Start selection after table of contents to avoid unwanted formatting
    objDoc.Range.Select
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

    'Need to iterate twice because TOC also has a Chapter 1 entry (d'oh!)
    For i = 1 To 2
     With Selection.Find
        .Text = "Chapter 1:"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
     End With
     Selection.Find.Execute
    Next i

    objDoc.ActiveWindow.Selection.MoveEnd Unit:=wdStory
    Set tempRange = ActiveWindow.Selection.Range
    Dim fc As Field
    'reformat color of pageref field codes within selected area
    For Each fc In tempRange.Fields
     If fc.Type = wdFieldPageRef Then
      fc.Select
      objDoc.ActiveWindow.Selection.Font.Color = 16748574
     End If
    Next fc


    '
    'properly configures document styles
    '
    Dim sty As Style
    Dim styl As Style

     'Clear quick style gallery of all styles that you don't want to add
     'Comment out if undesired
  For Each styl In objDoc.Styles
     If styl.Type = wdStyleTypeCharacter Or _
        styl.Type = wdStyleTypeParagraph Or _
        styl.Type = wdStyleTypeLinked Then
        styl.QuickStyle = False
     End If
  Next styl

  'cycle through each style and make necessary changes
  For Each sty In objDoc.Styles

     'Fix indenting and add core note styles to QSG
     If sty.NameLocal = "p_note" Then

      sty.NameLocal = "Note"
      With sty.ParagraphFormat
       .LeftIndent = InchesToPoints(0.52)
      End With
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_note2" Then
      sty.NameLocal = "Note2"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(0.67)
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_note3" Then
      sty.NameLocal = "Note3"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(0.9)
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_noteBull" Then
      sty.NameLocal = "NoteBullet"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(0.77)
      sty.QuickStyle = True
     End If

     'Fix and add core Caution styles
     If sty.NameLocal = "p_Caution" Then
      sty.NameLocal = "Caution"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(0.75)
      sty.ParagraphFormat.Borders.DistanceFromLeft = 7
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_CautionN2" Then
      sty.NameLocal = "Caution2"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(0.9)
      sty.ParagraphFormat.Borders.DistanceFromLeft = 7
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_CautionN3" Then
      sty.NameLocal = "Caution3"
      sty.ParagraphFormat.LeftIndent = InchesToPoints(1.13)
      sty.ParagraphFormat.Borders.DistanceFromLeft = 7
      sty.QuickStyle = True
     End If



     'Fix heading styles' outline level
     If sty.NameLocal = "h1" Then
      sty.ParagraphFormat.OutlineLevel = 1
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h1_heading2" Then
      sty.ParagraphFormat.OutlineLevel = 1
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_ChapterNumber" Then
      sty.ParagraphFormat.OutlineLevel = 1
     End If

     If sty.NameLocal = "p_ChapterNumber" Then
      sty.ParagraphFormat.OutlineLevel = 1
     End If

     If sty.NameLocal = "p_AppendixHeading" Then
      sty.ParagraphFormat.OutlineLevel = 1
     End If



     If sty.NameLocal = "h2" Then
      sty.ParagraphFormat.OutlineLevel = 2
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h2_Heading1" Then
      sty.ParagraphFormat.OutlineLevel = 2
     End If

     If sty.NameLocal = "h2_Heading2" Then
      sty.ParagraphFormat.OutlineLevel = 2
     End If

     If sty.NameLocal = "h2_Heading3" Then
      sty.ParagraphFormat.OutlineLevel = 2
     End If


     If sty.NameLocal = "h3" Then
      sty.ParagraphFormat.OutlineLevel = 3
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h2_ExerciseTitle" Then
      sty.ParagraphFormat.OutlineLevel = 2
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h3_ExerciseTitle" Then
      sty.ParagraphFormat.OutlineLevel = 3
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h3_Heading1" Then
      sty.ParagraphFormat.OutlineLevel = 3
     End If

     If sty.NameLocal = "h3_Heading2" Then
      sty.ParagraphFormat.OutlineLevel = 3
     End If

     If sty.NameLocal = "h3_Heading3" Then
      sty.ParagraphFormat.OutlineLevel = 3
     End If


     If sty.NameLocal = "h4" Then
      sty.ParagraphFormat.OutlineLevel = 4
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "h4_Heading3" Then
      sty.ParagraphFormat.OutlineLevel = 4
     End If

     If sty.NameLocal = "h4_Heading4" Then
      sty.ParagraphFormat.OutlineLevel = 4
     End If


     If sty.NameLocal = "h5" Then
      sty.ParagraphFormat.OutlineLevel = 5
      sty.QuickStyle = True
     End If


     If sty.NameLocal = "h6" Then
      sty.ParagraphFormat.OutlineLevel = 6
     End If



     'Fix odd extra note styles
     If sty.NameLocal = "p_note_1" Then
      With sty.ParagraphFormat
       .LeftIndent = InchesToPoints(0.77)
      End With
     End If

     If sty.NameLocal = "p_note_2" Then
      With sty.ParagraphFormat
       .LeftIndent = InchesToPoints(0.77)
      End With
     End If

     If sty.NameLocal = "p_note_3" Then
      With sty.ParagraphFormat
       .LeftIndent = InchesToPoints(1.04)
      End With
     End If

     If sty.NameLocal = "p_note_4" Then
      With sty.ParagraphFormat
       .LeftIndent = InchesToPoints(0.95)
      End With
     End If

     'Add other important styles to QuickStyle gallery
     '

     If sty.NameLocal = "p_ActionFirst" Then
      sty.NameLocal = "ActionFirst"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_Action" Then
      sty.NameLocal = "Action"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_Step1" Then
      sty.NameLocal = "StepFirst"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_Step" Then
      sty.NameLocal = "Step"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p" Then
      sty.NameLocal = "Normal1"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_Normal2" Then
      sty.NameLocal = "Normal2"
      sty.QuickStyle = True
     End If

     If sty.NameLocal = "p_Normal3" Then
      sty.NameLocal = "Normal3"
      sty.QuickStyle = True
     End If
Next sty


     '
     'Add borders to all images. Must be last step in processing.
     '
     Dim compare As Boolean
     'loop through inline shapes
     Dim iShape As InlineShape


     Dim shapeCount As Integer
     shapeCount = 1
     'loop through shapes
     For Each iShape In objDoc.InlineShapes

      'check to make sure each image is only processed once
      shapeCount = shapeCount + 1

      If shapeCount <= objDoc.InlineShapes.Count Then

       'check if the current shape is an picture
       iShape.Select
       If iShape.Type = wdInlineShapeLinkedPicture Or wdInlineShapePicture Then
        compare = True
       End If
       If iShape.Type = wdInlineShapePicture Or wdInlineShapeLinkedPicture Then

        'if necessary, change the border color to black
        iShape.Borders.OutsideLineStyle = wdLineStyleSingle

        'set border width to 1
        iShape.Borders.OutsideLineWidth = wdLineWidth100pt
       End If
      Else
       Exit Sub
      End If
     Next iShape






'Application.ScreenUpdating = True
End Sub