VBA: Формат текста MS Word

Question

Я пытаюсь форматировать текст нескольких слов. Пока что приведенный ниже код позволит мне отформатировать шрифт одного слова. Что мне нужно добавить/удалить, чтобы иметь столько слов, сколько я вставляю?

Cheers!

Sub FnFindAndFormat() 

    Dim objWord 
    Dim objDoc 
    Dim intParaCount 
    Dim objParagraph 
    Set objWord = CreateObject("Word.Application") 
    Set objDoc = objWord.Documents.Open("C:\USERPATH") 
    objWord.Visible = True 
    intParaCount = objDoc.Paragraphs.Count 

    Set objParagraph = objDoc.Paragraphs(1).range 
    objParagraph.Find.Text = "deal" 

    Do 
     objParagraph.Find.Execute 
     If objParagraph.Find.Found Then 
      objParagraph.Font.Name = "Times New Roman" 
      objParagraph.Font.Size = 20 
      objParagraph.Font.Bold = True 
      objParagraph.Font.Color = RGB(200, 200, 0) 
     End If 


    Loop While objParagraph.Find.Found 

End Sub 

Answer 1

Допустим, ваше слово документ выглядит следующим образом

Поскольку я не уверен, готовите ли вы это от Word-VBA или из другого приложения, как говорят Excel-VBA поэтому я в том числе обоих методов ,

Теперь, если вы делаете это с Word-VBA, вам не нужно LateBind с ним. Используйте этот простой код.

Option Explicit 

Sub Sample() 
    Dim oDoc As Document 
    Dim MyAr() As String, strToFind As String 
    Dim i As Long 

    '~~> This holds your search words 
    strToFind = "deal,contract, sign, award" 

    '~~> Create an array of text to be found 
    MyAr = Split(strToFind, ",") 

    '~~> Open the relevant word document 
    Set oDoc = Documents.Open("C:\Sample.docx") 

    '~~> Loop through the array to get the seacrh text 
    For i = LBound(MyAr) To UBound(MyAr) 
     With Selection.Find 
      .ClearFormatting 
      .Text = MyAr(i) 
      .Replacement.Text = "" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Execute 

      '~~> Change the attributes 
      Do Until .Found = False 
       With Selection.Font 
        .Name = "Times New Roman" 
        .Size = 20 
        .Bold = True 
        .Color = RGB(200, 200, 0) 
       End With 
       Selection.Find.Execute 
      Loop 
     End With 
    Next i 
End Sub 

Однако, если вы делаете из скажем Excel-VBA затем использовать этот

Const wdFindContinue = 1 

Sub FnFindAndFormat() 
    Dim objWord As Object, objDoc As Object, Rng As Object 
    Dim MyAr() As String, strToFind As String 
    Dim i As Long 

    '~~> This holds your search words 
    strToFind = "deal,contract, sign, award" 

    '~~> Create an array of text to be found 
    MyAr = Split(strToFind, ",") 

    Set objWord = CreateObject("Word.Application") 
    '~~> Open the relevant word document 
    Set objDoc = objWord.Documents.Open("C:\Sample.docx") 

    objWord.Visible = True 

    Set Rng = objWord.Selection 

    '~~> Loop through the array to get the seacrh text 
    For i = LBound(MyAr) To UBound(MyAr) 
     With Rng.Find 
      .ClearFormatting 
      .Text = MyAr(i) 
      .Replacement.Text = "" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Execute 

      Set Rng = objWord.Selection 

      '~~> Change the attributes 
      Do Until .Found = False 
       With Rng.Font 
        .Name = "Times New Roman" 
        .Size = 20 
        .Bold = True 
        .Color = RGB(200, 200, 0) 
       End With 
       Rng.Find.Execute 
      Loop 
     End With 
    Next i 
End Sub 

ВЫВОД