Reemplazar palabras o texto en múltiples documentos con Word es algo que alguna vez hemos podido precisar. Con el método convencional no nos queda más remedio que ir abriendo los archivos uno por uno y utilizar la función de remplazar, que se haya presente en nuestro menú Edición  de word. Pues bien, todo eso se ha acabado, ya que hoy os presentamos una macro que os permitirá sustituir una palabra en múltiples documentos sin tan siquiera tenerlos abiertos.

Para utilizar la macro que os dejamos a pie de artículo deberéis ubicar todos los documentos con los que deseéis llevar a cabo el reemplazo de palabras en una misma carpeta de vuestro disco duro. Solo os resta llevar a cabo los siguientes pasos:

  1. Abrir un nuevo documento en word.
  2. En el menú Herramientas, Macros, hacer click en el item, Editor de Visual Basic.
  3. En el explorador de proyectos deberemos navegar hasta la carpeta macros, Ubicada en el apartado Normal. Este apartado representa la plantilla normal.dot, y hará que nuestra macro esté a partir de ahora, disponible para cualquier documento que creemos. Sino visualizamos la ventana del explorador de proyectos en el Editor de Visual Basic, deberemos verificar, que en el menú Ver, tenemos seleccionada la opción Explorador de Proyectos. También podemos activarlo presionando las teclas Ctrl + R
  4. Una vez ubicados en la carpeta Módulos, del apartado normal, acudiremos al menú Insertar y seleccionaremos Módulos, se nos abrirá una nueva ventana en la que insertaremos este código

 


  Public Sub SustituirTextoTodosDocumentos()

 'Macro by Doug Robbins - 1st March 2004

 Dim PrimerLazo As Boolean
 Dim myFile As String
 Dim Trayectoria As String
 Dim myDoc As Document
 Dim rango As Word.Range
 Dim EncontrarTexto As String
 Dim Replacement As String
 ' Encontrar la carpeta que contiene los archivos
 With Dialogs(wdDialogCopyFile)
     If .Display <> 0 Then
         Trayectoria = .Directory
     Else
         MsgBox "Cancelado"
         Exit Sub
     End If
 End With
 'Cerrar documentos que esten abiertos
 If Documents.Count > 1 Then
     Documents.Close Savechanges:=wdPromptToSaveChanges
 End If
 PrimerLazo = True
 If Left(Trayectoria, 1) = Chr(34) Then
     Trayectoria = Mid(Trayectoria, 2, Len(Trayectoria) - 2)
 End If
 myFile = Dir$(Trayectoria & "*.doc")
 While myFile <> ""
     'Coger texto a reamplazar y reemplazarlo
    If PrimerLazo = True Then
         EncontrarTexto = InputBox("Escriba el texto que usted quiere reemplazar.", "Batch Replace Anywhere")
         If EncontrarTexto = "" Then
             MsgBox "Cancelado"
             Exit Sub
         End If
Tryagain:  Replacement = InputBox("Entre el texto nuevo.", "BatchReplaceAnywhere")
         If Replacement = "" Then
             Response = MsgBox("¿Quiere borrar el texto encontrado?", vbYesNoCancel)
             If Response = vbNo Then
                 GoTo Tryagain
             ElseIf Response = vbCancel Then
                 MsgBox "Cancelado"
                 Exit Sub
             End If
        End If
         PrimerLazo = False
     End If
     'Abrir para reemplazar texto a archivos
     Set myDoc = Documents.Open(Trayectoria & myFile)
     HacerlaValida
     For Each rango In ActiveDocument.StoryRanges
         Do
             BuscarYReemplazar rango, EncontrarTexto, Replacement
             Set rango = rango.NextStoryRange
         Loop Until rango Is Nothing
     Next
     'Cerrar Archivos Guardando los cambios
     myDoc.Close Savechanges:=wdSaveChanges
     myFile = Dir$()
 Wend
 End Sub
 Public Sub BuscarYReemplazar(ByVal rango As Word.Range, _
                                    ByVal strSearch As String, _
                                    ByVal strReplace As String)
 'rutina provista by Peter Hewett
         Do Until (rango Is Nothing)
         With rango.Find
             .ClearFormatting
             .Replacement.ClearFormatting
             .Text = strSearch
             .Replacement.Text = strReplace
             .Forward = True
             .Wrap = wdFindContinue
             .Format = False
             .MatchCase = False
             .MatchWholeWord = False
             .MatchAllWordForms = False
             .MatchSoundsLike = False
             .MatchWildcards = False
             .Execute Replace:=wdReplaceAll
         End With
        Set rango = rango.NextStoryRange
     Loop
 End Sub
 Public Sub HacerlaValida()


     Dim lngJunk As Long
     lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType

 End Sub

 

Modificacion de codigo para reemplazar  una palabra por otra en multiples documentos

No esta adapatado el error para el caso que si se emplea el codigo para archivos que estan en Red si estos no tienen permisos Totales para Escritura entonces NO esta controlado el error.....

 


 Public Sub SustituirTextoTodosDocumentos()

 Dim x As Boolean, ruta As String, archivos As String, _
 myDoc As Document, rango As Word.Range, buscar As String
 Dim reemplazo
    
 With Dialogs(wdDialogCopyFile)
 If .Display <> 0 Then
 archivos = .Directory
 Else: MsgBox "Cancelado"
 Exit Sub: End If
 End With
 x = 1
 If Left(archivos, 1) = """" Then _
 archivos = Mid(archivos, 2, Len(archivos) - 2)
 ruta = Dir$(archivos & "*.doc")
 While ruta <> ""
 If x Then
 buscar = InputBox("texto a buscar", "Buscando...")
 If buscar = "" Then MsgBox "Cancelado": Exit Sub
 reemplazo = InputBox("texto de reemplazo", "reemplazando...")
 If reemplazo = "" Then MsgBox "exit...": Exit Sub
 End If
 x = 0
 Set myDoc = Documents.Open(archivos & ruta)
 'If myDoc.ProtectionType <> wdNoProtection Then _
  '  myDoc.Unprotect
  With myDoc.Range.Find
  .Text = buscar
  .Replacement.Text = reemplazo
  .Execute Replace:=wdReplaceAll
 End With
 'myDoc.Protect (wdAllowOnlyFormFields)
 myDoc.Close Savechanges:=wdSaveChanges
 ruta = Dir$()
 
 Wend
 
 
 End Sub

 

 


 

A partir de ahora cada vez que abramos un nuevo documento, veremos que si acudimos, al menú Herramientas > Macros > macros,  tenemos listado un nuevo item, llamado SustituirTextoTodosDocumentos, con cuya ejecución podremos llevar a cabo la sustitución de una palabra por otra en múltiples documentos a la vez.

{jos_sb_discuss:6}