Замена текста в колонтитуле макросом - VBA

Формулировка задачи:

Здравствуйте! В ходе разработки проектов возникла необхоидмость создавать большое количество пояснительных записок. Иными словами - создание большого количества документов word по шаблону. Макрос ищет нужную комбинацию символов и заменяет его на заданное значение или текст из ячейки в экселе. Однако возникла проблема: дело в том, что в проекте используется колонтитул для описания проекта (таблица). В этой таблице так же есть значения, которые должны меняться, однако макрос этого не делает. Подскажите пожалуйста, что необходимо добавить в макрос?

                    Листинг программы
                
 
                            
                        
Sub СформироватьПроекты()
    ПутьШаблона = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблона)
    НоваяПапка = NewFolderName & Application.PathSeparator
    Dim row As Range, pi As New ProgressIndicator
    r = Cells(Rows.Count, "A").End(xlUp).row: rc = r - 2
    If rc < 1 Then MsgBox "Строк для обработки не найдено", vbCritical: Exit Sub
 
    pi.Show "Формирование проектов": pi.ShowPercents = True: s1 = 10: s2 = 90: p = s1: a = (s2 - s1) / rc
    pi.StartNewAction , s1, "Запуск приложения Microsoft Word"
 
    ' Dim WA As Word.Application, WD As Word.Document: Set WA = New Word.Application    ' c подключением библиотеки Word
    Dim WA As Object, WD As Object: Set WA = CreateObject("Word.Application")    ' без подключения библиотеки Word
 
    For Each row In ActiveSheet.Rows("3:" & r)
        With row
            ФИО = Trim$(.Cells(1))
            Filename = НоваяПапка & ФИО & РасширениеСоздаваемыхФайлов
 
            pi.StartNewAction p, p + a / 3, "Создание нового файла на основании шаблона", ФИО
            Set WD = WA.Documents.Add(ПутьШаблона): DoEvents
 
            pi.StartNewAction p + a / 3, p + a * 2 / 3, "Замена данных ...", ФИО
            For i = 1 To КоличествоОбрабатываемыхСтолбцов
                FindText = Cells(1, i): ReplaceText = Trim$(.Cells(i))
 
                ' так почему-то заменяет не всё (не затрагивает таблицу)
                'WA.Selection.Find.Execute FindText, , , , , , , wdFindContinue, False, ReplaceText, True
 
                pi.line3 = "Заменяется поле " & FindText
                With WD.Range.Find
                    .Text = FindText
                    .Replacement.Text = ReplaceText
                    .Forward = True
                    .Wrap = 1
                    .Format = False: .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                    .Execute Replace:=2
                                        
                End With
                DoEvents
            Next i
            pi.StartNewAction p + a * 2 / 3, p + a, "Сохранение файла ...", ФИО, " "
            WD.SaveAs Filename: WD.Close False: DoEvents
            p = p + a
        End With
    Next row
 
    pi.StartNewAction s2, , "Завершение работы приложения Microsoft Word", " ", " "
    WA.Quit False: pi.Hide
    msg = "Сформировано " & rc & " проектов. Все они находятся в папке" & vbNewLine & НоваяПапка
    MsgBox msg, vbInformation, "Формирование ПРОЕКТОВ прошло успешно"
End Sub

Решение задачи: «Замена текста в колонтитуле макросом»

textual
                            Листинг программы 
                        
 
                        
                          
                    
WA.ActiveWindow.ActivePane.View.SeekView = 9  ' активировать непервый нижний колонтитул
With WA.Selection.Find
' ...
End With
WA.ActiveWindow.ActivePane.View.SeekView = 9  ' активировать непервый верхний колонтитул
With WA.Selection.Find
' ...
End With
WA.ActiveWindow.ActivePane.View.SeekView = 0 ' вернуться в тело документа