vbaで単語やフレーズを検索し、それに続く段落全体をハイライトします

Question

キーワードやフレーズを見つけるために次のコードを使用しましたが、その行を強調表示しましたが、全体をハイライト表示する方法はわかりません段落やそれに続くリスト...

たとえば、 （理想的には、この段落を強調表示し、さらに詳細を提供するリストが最適ですが、段落のみが達成可能であれば何もありません）。

"契約者は毎月末から10営業日以内に月次状況報告書を送付するも​​のとします。報告書には以下が含まれていなければなりません （a）達成度私はいくつかのコマンドを研究し、例を探しましたが、まだ初心者としては迷っています。私は "wdParagraph"を試しましたが、うまく動作しませんでした。たぶん "paragraph.range.select"を使っているかもしれませんが、段落を選択するためにこれらの "開始"と "終了"の用語をアドバイスしたメモも見つかりました。誰かがこれを達成する方法の例を持っているので、100ページのワード文書の中から何百ものソフトウェア要求をすばやく特定することが大いに役立ちます。 * Selection.StartOf単位：= wdParagraphm * Selection.MoveEnd単位：= 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 

Answer 1

素晴らしい専門家のカップルは私が必要と強調し、完全な段落を達成するために私と一緒に2つの方法を共有した。これらは、他人を助けるホープ！同じ結果を達成するためのさまざまな方法を見て魅力的です！

方法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 =偽）：

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