Reemplazar encabezado Word
Publicado por Cristian (1 intervención) el 19/04/2018 13:27:35
Hola,
Necesito reemplazar el encabezado de cientos de documentos Word, estos están en varios directorios y necesitaría mantener esa estructura de carpetas.
Bien, lo he intentado con esta macro, me deja hacer un reemplazar pero solo en el cuerpo del .doc y solo de los que cuelgan de una carpeta, no consigo hacer que funcione con el texto de la cabecera...
Esto me ha llevado a pensar que, quizás sería más sencillo substituir la cabecera de todos esos documentos a partir de un documento/plantilla de referencia. ¿Es posible? ¿Cómo se podría llevar a cabo?
La macro:
Gracias por vuestra ayuda, saludos.
Necesito reemplazar el encabezado de cientos de documentos Word, estos están en varios directorios y necesitaría mantener esa estructura de carpetas.
Bien, lo he intentado con esta macro, me deja hacer un reemplazar pero solo en el cuerpo del .doc y solo de los que cuelgan de una carpeta, no consigo hacer que funcione con el texto de la cabecera...
Esto me ha llevado a pensar que, quizás sería más sencillo substituir la cabecera de todos esos documentos a partir de un documento/plantilla de referencia. ¿Es posible? ¿Cómo se podría llevar a cabo?
La macro:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Public Sub SustituirTextoTodosDocumentos()
Dim por 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 IfEnd With
por = 1If Left(archivos, 1) = """" Then _
archivos = Mid(archivos, 2, Len(archivos) - 2)
ruta = Dir$(archivos & "*.docx")
While ruta <> ""
If por 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
por = 0Set 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
Public Sub SustituirTextoTodosDocumentos2()
Dim por 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 IfEnd With
por = 1If Left(archivos, 1) = """" Then _
archivos = Mid(archivos, 2, Len(archivos) - 2)
ruta = Dir$(archivos & "*.docx")
While ruta <> ""
If por 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
por = 0Set myDoc = Documents.Open(archivos & ruta)
'If myDoc.ProtectionType <> wdNoProtection Then _
' myDoc.Unprotect
'With myDoc.Range.Find
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Text = buscar
.Replacement.Text = reemplazo
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
End With
'myDoc.Protect (wdAllowOnlyFormFields)
myDoc.Close Savechanges:=wdSaveChanges
ruta = Dir$()
Wend
End Sub
Gracias por vuestra ayuda, saludos.
Valora esta pregunta
0