Word中的宏,用于为文档中的每个段落添加下划线,长度小于X个字符

时间:2015-06-10 18:09:09

标签: vba ms-word ms-office word-vba

我有几页的文字。文档中有许多行是短标题,然后是回车符,然后是描述性段落。不是头版新闻。

例如

  

条件后续

     

随后的条件通常在法律背景下用作结束一个人合法权利或义务的标记。后续条件可能是必须(1)发生或(2)未能继续发生的事件或事态。

这类事情一直延续到长文档的痛苦结尾,有100多个标题 - 需要加下划线!

我已经使用此代码查找所有少于100个字符的下划线,这有效,但如果段落的最后一行少于100个字符也会加下划线,我不想要:

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

但是,当我尝试(下面)查找段落并计算段落中的字符数时,Word会在下面突出显示的两行中引发错误:

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 个答案:

答案 0 :(得分:1)

编辑解决方案

为后人......

此代码查找少于100个字符的所有段落(假定标题)并为其加下划线:

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