Macro in Word to Underline each paragraph in document less than X characters long

724 views Asked by At

I have a word doc of several pages. There are many lines in the document that are short headings, then the carriage return, then a descriptive paragraph. Not front page news.

eg

Condition Subsequent

A condition subsequent is often used in a legal context as a marker bringing an end to one's legal rights or duties. A condition subsequent may be either an event or a state of affairs that must either (1) occur or (2) fail to continue to occur.

This sort of thing goes on down to the bitter end of the long document, with over 100 headings - that need to be underlined!

I have used this code to look for all lines less than 100 characters to underline, which works, but if the last line of a paragraph is less than 100 characters that also gets underlined, which I dont want:

Sub Underline_Header()
    Dim numOfLines As Integer
    numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")
    Selection.HomeKey Unit:=wdStory

    For x1 = 1 To numOfLines
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        char_count = Len(Selection.Range.Text)
        If char_count < 100 Then
            Selection.Font.Underline = True
        End If
        Selection.MoveDown Unit:=wdLine, Count:=1
    Next x1
End Sub

But when I try this (below) to look for paragraphs and count the number of characters in the paragraph, Word throws an error at the two lines highlighted below:

Sub Underline_Header()
    Dim numOfParagraphs As Integer
    numOfParagraphs = ActiveDocument.BuiltInDocumentProperties("NUMBER OF PARAGRAPHS")
    Selection.HomeKey Unit:=wdStory

    For x1 = 1 To numOfParagraphs
        *>>Selection.HomeKey Unit:=wdParagraph
        >>Selection.EndKey Unit:=wdParagraph, Extend:=wdExtend*
        char_count = Len(Selection.Range.Text)
        If char_count < 100 Then
            Selection.Font.Underline = True
        End If
        Selection.MoveDown Unit:=wdParagraph, Count:=1
    Next x1
End Sub
1

There are 1 answers

0
thenextbigthing On BEST ANSWER

EDIT SOLUTION FOUND

For posterity ...

This code finds all paragraphs with less than 100 characters (assumes a heading) and underlines them:

Sub Underline_Header()

Dim numOfParagraphs As Integer
numOfParagraphs = ActiveDocument.BuiltInDocumentProperties("NUMBER OF PARAGRAPHS")
Selection.HomeKey Unit:=wdStory
For x1 = 1 To numOfParagraphs

Selection.Paragraphs(1).Range.Select

char_count = Len(Selection.Paragraphs(1).Range)

If char_count < 100 Then
Selection.Font.Underline = True
End If

Selection.MoveDown Unit:=wdParagraph, Count:=1

Next x1


End Sub

fwiw