Visual Basic - Sustituir en encabezado de Word desde macro de Excel

Sub Sustituir()

' RUTA es el directorio donde se encuentra el fichero Word y NOMBRE su nombre.

Dim RUTA, NOMBRE As String

Dim CADENABUSCAR, CADENAESCRIBIR As String

Dim MiDOCUWord As Object

Set MiDOCUWord = CreateObject("word.application")

RUTA = "C:\Users\Juan\Desktop\"

NOMBRE="Fichero.docx"

CADENABUSCAR = "83 años"

CADENAESCRIBIR = "ochenta y tres años"

With MiDOCUWord

.Visible = True

.Documents.Open RUTA & NOMBRE

.Activate

With .ActiveDocument.Content.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = CADENABUSCAR

.Replacement.Text = CADENAESCRIBIR

.Forward = True

.Wrap = 1 'wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

.Execute Replace:=2 'wdReplaceAll

End With

End With

End Sub

Sub Macro_Word_Sustituir_en_Encabezado()

    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then

        ActiveWindow.Panes(2).Close

    End If

    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _

        ActivePane.View.Type = wdOutlineView Then

        ActiveWindow.ActivePane.View.Type = wdPrintView

    End If

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "83 años"

        .Replacement.Text = "23 primaveras"

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub