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

binar · 12-23-2012, 08:16 PM

Macropod,
Thanks a million for your last post. I can assure you with 100% certainty that all of the UNDERLINE formatting for all HEADING (Levels 1 thru 6) were applied by activating the UNDERLINE button within the Style Definition for each HEADING style. I can assure you of this because I was the one that did it.

The original author was not following Military Standard 38784. However, when I took over the document I was tasked with changing it over to MIL STD 38784 and one of the first things I did was apply all of the UNDERLINE formatting because I immediately realized this change could easily be done by making a small change to the Style Definition for each HEADING style. However, when it got to adding all of the PERIODs I remember not being a happy camper because this document has way too many heading paragraphs to manually add PERIODs to one by one. In addition, I noticed that some HEADINGs already had PERIODs applied while others did not. This is when I decided to start this thread in an effort to learn how the mundane task of adding PERIODs (with no underline applied) could be done with very little effort.

When I get back to work after the New Year holiday I will try out the code below on a backup copy I made of the document before applying your macro and let you know if adding the extra line of code fixes the problem with additional underline subtraction. Again, thanks a million for your help with this code. Your contribution to this thread is very much appreciated.

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"
   .Replacement.Font.Underline = True
      .Execute Replace:=wdReplaceAll
      .Text = ".^13"
      .Replacement.Text = "^&"
      .Replacement.Font.Underline = False
      .Execute Replace:=wdReplaceAll
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub