Visual Basic - Reemplazar encabezado de varios documentos Word

Life is soft - evento anual de software empresarial
 
Vista:

Reemplazar encabezado de varios documentos Word

Publicado por Cristian (1 intervención) el 18/04/2018 08:26:44
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:

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 If
End With
por = 1
If 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 = 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
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 If
End With
por = 1
If 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 = 0
Set 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


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?

También he estado realizando pruebas con Writer pero sin éxito...

Gracias por vuestra ayuda, saludos.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Reemplazar encabezado de varios documentos Word

Publicado por Antoni Masana (558 intervenciones) el 19/04/2018 20:30:59
Pregunta:

¿Esta macro la ejecutas en un Excel o en un Word?

Desde el Excel no puedes modificar las cabeceras ya lo he intentado y es imposible mientras alguien no me demuestre lo contrario.

Desde el Word es mucho más facíl de hacer.

Creo que con estas lineas se accede a la cabecera

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
sub Cabecera()
    ....
    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
 
    On Error GoTo Error
 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    ....
End Sub

Si no funciona usa el truco de GRABAR MACRO y realiza la acción. Es muy gratificante.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar