1
votes

I have been using this code to Bold-Underline all the headers in my word doc:

Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
    If Len(p.Range.Text) < 70 Then
        p.Range.Font.Underline = True
        p.Range.Font.Bold = True
    End If
Next p
End Sub

This works great - as long as every header is less than 70 characters long, and the paragraph underneath it is 70 or more characters.

But many times the header can be longer than 70 characters, and the paragraph under the header can be less than 70 characters.

However, the headers always never end with any punctuation, like a "." but the paragraphs underneath them always do.

I am trying to fix the code above to look for all paragraphs not ending in a "." and then Bold-Underline them. In other words, I want to change the rule.

I tried the only thing that made sense to me. The code did not break, but it ended up bold-underline the entire document:

Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
    If Right(p.Range.Text,1) <> "." Then
        p.Range.Font.Underline = True
        p.Range.Font.Bold = True
    End If
Next p
End Sub

This supposedly looks for all paragraphs where the last character is not ".", which if that worked, would isolate all the headers and only bold-underline them, but obviously that doesn't work.

1

1 Answers

1
votes

The last character in every paragraph is a carriage return, Chr(13). The text ends one character before that. The code below also considers the possibility that someone ended a paragraph's text with one or more blank spaces. It takes the "cleaned" string and looks for the last character in a string of possible exceptions, like .?!. You can reduce this string to a single full stop or extend it to include more cnadidates for exception.

Private Sub UnderlineTitles()

    Dim Para As Paragraph
    Dim Txt As String

    Application.ScreenUpdating = False
    For Each Para In ActiveDocument.Paragraphs
        Txt = Para.Range.Text
        Txt = RTrim(Left(Txt, Len(Txt) - 1))
        ' you can extend the list to include characters like ")]}"
        If InStr(".?!", Right(Txt, 1)) = 0 Then
            ' to choose a different style of underline, remove
            ' "= wdUnderlineSingle", type "=" and select from the dropdown
            Para.Range.Font.Underline = wdUnderlineSingle
        End If
    Next Para
    Application.ScreenUpdating = True
End Sub