Corregir macro para reemplazar textos de Excel Word

[Hola

Primero que nada, si te refieres a que la macro sola busque el archivo en el o los discos duro, te aseguro que no es tan simple.

Segundo, mientras comentas/piensas lo primero, haz estas modificaciones:

- Tus datos a reemplazar comienzan en "A7", no en "A2" por tanto modifica esta línea:

For Each Celda In Range("A7:A" & UltimaFila)

- Anda a las referencias del VBA (Herramientas  - Referencias) y activa:

"Microsoft Word 16.0 Object Library"

En donde el número 16.0 puede variar en base a tu versión de Office. Ah, ojo, las "referencias" no 'viajan' con los archivos, por lo que si quieres que otras personas con distinta versión de Office usen el archivo, pues tendrán que activar su propia "referencia". ¿Un modo de que se haga automático? También es bastante complicado y no necesariamente será efectivo en toda PC.

- Agrega estas líneas antes del "End Sub":

MsgBox "Todo listo"
MiappWord.Visible = True

En donde si deseas quitas la última y coloca estas:

MiappWord.Quit
Set MiappWord = Nothing

Ahora sí ya no tendrás problemas.

Abraham Valencia

Estimado Abraham Valencia ante todo agradecerte por esta inmensa ayuda, ya que mi persona no tiene aún un conocimiento avanzado en el mundo de programación, Y tengo una duda aun ya que es algo tedioso estar entrando al lenguaje de la macro y poner la dirección nuevamente de los archivos, sería posible que la dirección del archivo lo pueda poner el la celda B4, por que así seria más rápido digitalizar las direcciones de todos los archivos.

Prueba así:

Dim MiappWord As Object
Dim UltimaFila As Long
Dim Celda As Range
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "Aceptar"
.Title = "Elegir archivo"
    If .Show = 0 Then
        MsgBox "Cancelaste"
        Exit Sub
    Else
        Range("B4") = .SelectedItems(1)
    End If
End With
Set MiappWord = CreateObject("Word.Application")
MiappWord.Documents.Open ThisWorkbook.Path & "\TEXTO1.rtf"
Let UltimaFila = Cells(Rows.Count, "A").End(xlUp).Row
For Each Celda In Range("A7:A" & UltimaFila)
    MiappWord.Selection.Find.ClearFormatting
    MiappWord.Selection.Find.Replacement.ClearFormatting
    With MiappWord.Selection.Find
        .Text = Celda.Value 'Texto orginal
        .Replacement.Text = Celda.Offset(0, 1).Value ' texto por el que se reemplaza
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    MiappWord.Selection.Find.Execute Replace:=wdReplaceAll
Next Celda
MsgBox "Todo listo"
MiappWord.Visible = True

Comentas

Abraham Valencia

Perdón, cambia por esta la línea respectiva;

MiappWord.Documents.Open Range("B4").Value

Ahora sí

Abraham Valencia

lo puse de esta forma:

Dim MiappWord As Object
Dim UltimaFila As Long
Dim Celda As Range
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "Aceptar"
.Title = "Elegir archivo"
    If .Show = 0 Then
        MsgBox "Cancelaste"
        Exit Sub
    Else
        Range("B4") = .SelectedItems(1)
    End If
End With
Set MiappWord = CreateObject("Word.Application")
MiappWord.Documents.Open Range("B4").Value
Let UltimaFila = Cells(Rows.Count, "A").End(xlUp).Row
For Each Celda In Range("A7:A" & UltimaFila)
    MiappWord.Selection.Find.ClearFormatting
    MiappWord.Selection.Find.Replacement.ClearFormatting
    With MiappWord.Selection.Find
        .Text = Celda.Value 'Texto orginal
        .Replacement.Text = Celda.Offset(0, 1).Value ' texto por el que se reemplaza
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    MiappWord.Selection.Find.Execute Replace:=wdReplaceAll
Next Celda
MsgBox "Todo listo"
MiappWord.Visible = True