ActiveDocument.Shapes("Text Box 2").Select
'У активной книги Word, которую только что открыли, обращаемся к конкретному полю

Selection.WholeStory: Selection.Delete
'Выделяем и удаляем всё, что в этом поле есть.

Selection.TypeText Text:="Новый Текст"
'Вставляем в поле текст, какой душе угодно

{IF "Первый" = "Второй" "Да" "{IF "Первый" = "Третий" "Да" "{IF "Первый" = "Четвертый" "Да" "{IF "Первый" = "Пятый" "Да" "Нет"}"}"}"}

For each object in ActiveDocument.Shapes ...

With Selection.Find
        .Text = "1500 нет"
        .Replacement.Text = "1200 да"
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
End With

.tables(1).Rows(4).Cells(2).Range.Text

Sub replace_()
     Dim appWord As Object, docWord As Object
     Dim OfficeApp As Object, ReadOnly As Boolean
     Dim path$, FName$, docpath$
      
     path = ThisWorkbook.path: FName = "replace.doc"
     docpath = path & "\" & FName: ReadOnly = True
     Set OfficeApp = CreateObject("Word.Application")
     Set docWord = OfficeApp.Documents.Open(Filename:=docpath, _
         ReadOnly:=ReadOnly)
     If docWord Is Nothing Then Exit Sub
     Set appWord = docWord.Application
      
     Dim i&, s$, s1$, s2$, zz&
      
     s1 = "Первый"
     s2 = "Третий"
      
     appWord.Documents(FName).Windows(1).View.ShowFieldCodes = 1
      
     With appWord.Documents(FName).Range
         .Find.Text = s1: .Find.Replacement.Text = s2
         .Find.Forward = True
           
         .Find.Execute
         If .Find.Found Then
               .Find.Execute Replace:=2
         End If
     End With
      
     With appWord.Documents(FName).Shapes
         If .Count Then
             For zz = 1 To .Count
                 If .Item(zz).TextFrame.HasText Then
                     With .Item(zz).TextFrame.TextRange
                         If InStr(1, .Text, s1, 1) Then
                             .Find.Text = s1: .Find.Replacement.Text = s2
                             .Find.Execute Replace:=2
                             .Fields.Update
                         End If
                     End With
                 End If
             Next
         End If
     End With
      
     appWord.Documents(FName).Windows(1).View.ShowFieldCodes = 0
     appWord.Documents(FName).Fields.Update
     appWord.Visible = 1
     appWord.ScreenUpdating = 1
End Sub

.Fields.Update