vba找到单词或短语然后突出显示其后面的整个段落

时间:2016-09-08 01:26:04

标签: highlight paragraph

我使用以下代码查找关键字或短语然后突出显示该行 - 但无法弄清楚如何使其突出显示整个段落和/或其后的列表......

例如: (理想情况下,突出显示这一段并且提供更多详细信息的列表最好 - 但如果只有段落可以实现,那就更好了):

“承包商应在每个月结束后的十个工作日内提交月度状态报告。报告应包括: (a)成就 (b)会议和成果 (c)完成旅行和旅行目的“

我已经研究过几个命令并查找了一些示例,但作为一个新手仍然不知所措。我试过“wdParagraph”,但无法让它工作。可能使用“paragraph.range.select”的refs也发现了一个注释,建议这些“开始”和“结束”术语(下面)选择一个段落..但不知道如何实现这一点?希望有人有一个如何实现这一目标的例子,因为它将有助于快速识别100页单词文档中的数百个软件需求......太沮丧了!  * Selection.StartOf单位:= wdParagraphm  * Selection.MoveEnd Unit:= wdParagraph

Sub Find_Highlight_Word_to_End_of_Line()

'BUT NEED IT TO HIGHLIGHT THROUGH END OF PARAGRAPH
'AND HIGHLIGHT LISTED ITEMS IF APPLICABLE
'LIKE THE LISTS IN THE EXAMPLE DOCUMENT

Dim sFindText As String
'Start from the top of the document
 Selection.HomeKey wdStory

sFindText = "Contractor Shall"
Selection.Find.Execute sFindText

Do Until Selection.Find.Found = False
Selection.EndKey Unit:=wdLine, Extend:=wdExtend

        Selection.Range.HighlightColorIndex = wdYellow
        Selection.MoveRight
        Selection.Find.Execute

Loop
End Sub

1 个答案:

答案 0 :(得分:0)

一些很棒的专家与我分享了两种方法,以实现我需要的完整段落突出显示...希望这些帮助别人!看到不同的方法来实现相同的结果很有吸引力!

方法2代码(替代)更短:

Sub Highlight_Paragraph() 
    Dim oRng As Range 
    Set oRng = ActiveDocument.Range 
    With oRng.Find 
        Do While .Execute(FindText:="Contractor Shall") 
            oRng.Paragraphs(1).Range.HighlightColorIndex = wdYellow 
            oRng.Collapse 0 
        Loop 
    End With 
lbl_Exit: 
    Set oRng = Nothing 
    Exit Sub 
End Sub

方法1代码(MatchWildcards = False):

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "Contractor Shall"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchWildcards = False
  .Execute
  End With
  Do While .Find.Found
  .Duplicate.Paragraphs.First.Range.HighlightColorIndex = wdYellow
  .Start = .Duplicate.Paragraphs.First.Range.End
  .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub