このスクリプトを動作させることができません

Question

太字をすべて見つけて書式を変更しようとしていますので、大胆な単語を検索する2つのループと書式を変更するための2つのループを使って書式を変更しようとしています。誰かが私にそれをする方法を教えてください/どのような助けが大いに感謝されることができますか？ 'ありがとう

Sub SearchBoldText() 
    Dim rng As Range 
    Set rng = ThisDocument.Range(0, 0) 
    With rng.Find 
     .ClearFormatting 
     .Format = True 
     .Font.Bold = True 


     While .Execute 
      rng.Select 
      rng.Collapse direction:=wdCollapseEnd 
     Wend 

     Do Until rng = 0 
       With Selection.Font 
        .Name = "Times New Roman" 
        .Size = 20 
        .Bold = True 
        .Color = RGB(200, 200, 0) 
       End With 
       Selection.Find.Execute 
      Loop 
     End With 
    End With 
    Set rng = Nothing 
End Sub 

Answer 1

この問題では2つのループは必要ありません。あなたの範囲がA1からF40であるとしましょう。私はフォーマットを変更しなかったが、セルの背景を赤にしたことに注意してください。あなたはあなたのニーズに適応することができます。 Excelの

：Wordの

Sub SelectBold() 
    Dim Rng As Range 
    Dim WorkRng As Range 

    Set WorkRng = Range("A1:F40") 

    For Each Rng In WorkRng 
     If Rng.Font.Bold Then 
      Rng.Interior.Color = RGB(255, 0, 0) 
     End If 
    Next 
End Sub 

：

Sub findBold() 
    Selection.Find.ClearFormatting 
    Selection.Find.Font.Bold = True 
    Selection.Find.Replacement.ClearFormatting 
    Selection.Find.Replacement.Font.Size = 20 
    Selection.Find.Replacement.Font.ColorIndex = wdYellow 
    Selection.Find.Replacement.Font.Name = "Times New Roman" 
    With Selection.Find 
     .Text = "" 
     .Replacement.Text = "" 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
End Sub