Challenging Heading Edit with Find Replace

macropod · #1 12-22-2012, 11:07 PM

Hi binar,

Quote:

something in the code is making it subtract an additional single UNDERLINE space that is not needed. In other words, the macro does a great job of not applying an UNDERLINE to the PERIOD character located at the end, but then it goes a step beyond and also subtracts an additional UNDERLINE space from the last letter character located to the left of the PERIOD. In short, it looks like the example below:

3.4 Heading 2 Example.

That suggests your heading Styles don't include the underlining and someone has applied that manually. That is a poor use of the Styles. Used correctly - with the underlining applied to the Style definitions, this would not occur. Ideally, you should get the Style deinitions right before running the macro.

Nevertheless, even without getting the Style definitions right you can work around the issue by inserting:
.Replacement.Font.Underline = True
before the first:
.Execute Replace:=wdReplaceAll

And, if you've already saved your work with the 'erroneous' underlining, you can redeem it by changing the first F/R expression to:
.Text = "([!.].)(^13)"
.Replacement.Text = "\1\2"
(with the addition of the '.Replacement.Font.Underline = True' line).

PS: Please don't automatically quote the entire post replied to each time you post. It's quite unnecessary and just clutters the thread. If there's a particular element of the post replied to that warrants quoting, then quote just that portion - as I have done in this reply.

binar · #2 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to replace one specific heading style with another	ubns	Word VBA	44	09-04-2012 08:17 PM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM
Is there a way to use "find/replace" to find italics words?	slayda	Word	3	09-14-2011 02:16 PM
Find and Replace	kjxavier	Excel	3	08-12-2011 10:49 PM
Help with find and replace or query and replace	shabbaranks	Excel	4	03-19-2011 08:38 AM