Microsoft Office Forums - View Single Post - Challenging Heading Edit with Find Replace

macropod · 12-10-2012, 02:06 AM

There really are only two steps, both of which you've been given. The issue seems to be that you really don't understand what those two steps are doing and, perhaps, aren't implementing them correctly. Your 1 & 2 are already encompassed by my 1 (your 2).

The following macro implements both steps for all headings in the document.

Code:

Sub FixHeadings()
Application.ScreenUpdating = False
Dim i As Integer
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Format = True
    For i = 1 To 9
      .Style = "Heading " & i
      .Text = "([!.])(^13)"
      .Replacement.Text = "\1.\2"
      .Execute Replace:=wdReplaceAll
      .Text = ".^13"
      .Replacement.Text = "^&"
      .Replacement.Font.Underline = False
      .Execute Replace:=wdReplaceAll
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub