Imprimir página | Cerrar ventana

VBA Reemplazar fecha de cabecera

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Word
Descripción del foro: Foro de Word
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=80251
Fecha de impresión: 16/Febrero/2020 a las 19:59


Tema: VBA Reemplazar fecha de cabecera
Publicado por: solaire
Asunto: VBA Reemplazar fecha de cabecera
Fecha de publicación: 11/Febrero/2015 a las 12:34
Hola a todos!
Ando con un VBA que me tiene la cabeza frita
El VBA lo que hace es remplazar la fecha que se encuentra en la cabecera de varios documentos de una carpeta (c:\Nueva carpeta)
Hasta ahora esto es lo que he hecho:

Sub FindAndReplaceFirstStoryOfEachType()
Set objRegEx = CreateObject("vbscript.regexp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
objRegEx.Pattern = "[0-9]{2}/[0-9]{2}/[0-9]{4}"


Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
If Not IsEmpty(rngStory) Then
With rngStory.Find
    If objRegEx.test(rngStory) = True Then

     .Text = CStr(rngStory)
     .Replacement.Text = Format(Now(), "mm/dd/yyyy")
     .Wrap = wdFindContinue
     .Execute Replace:=wdReplaceAll
    End If
End With

End If
Next rngStory
End Sub


El caso es que no consiguo de ninguna manera de las que lo he intentado que el cambio de fecha se aplique a la cabecera.
Lo he intentado con este codigo:

ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

Pero este lo unico que hace es modificar la primera celda de la cabecera y no se puede moverse a traves de la cabecera a donde esta la fecha

Espero que me podais ayudar, un saludo



Respuestas:
Publicado por: prga
Fecha de publicación: 11/Febrero/2015 a las 16:50
Hola.
¿Seguro que este código es para el VBA de access? ¿No será para el VBA de word?
Sí es para word habrá que 'trasladar' el hilo al foro de word
Ya comentas.
Un saludo a todos



Publicado por: solaire
Fecha de publicación: 12/Febrero/2015 a las 10:50
Perdon si que es de Word
Al final tras investigar y preguntar por otros sitios lo he conseguido
Para el que le interese hay le va el codigo :
Este para abrir en varios words, lo guardas en una plantilla
Sub openf()
Dim FSO As Object
Dim fPath As String
Dim myFolder, myFile
Dim wdApp As Object
Dim wdDoc As Variant

fPath = "C:\" 'change to your directory
Set wdApp = GetObject(, "Word.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.GetFolder(fPath).Files
For Each myFile In myFolder
If LCase(myFile) Like "*.docx" Then 'change to you file type
      Set wdDoc = wdApp.Documents.Open(CStr(myFile))
      wdApp.Visible = True
      FindAndReplaceFirstStoryOfEachType
      wdDoc.Save
      wdDoc.Close
      Set wdDoc = Nothing
End If
Next myFile

End Sub


Y luego este que modifica la cabecera:
Sub FindAndReplaceFirstStoryOfEachType()

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.MoveRight Unit:=wdCharacter, Count:=14
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy")
Selection.MoveLeft Unit:=wdCharacter, Count:=4
Selection.TypeBackspace
Selection.TypeText Text:="/"
End Sub



Imprimir página | Cerrar ventana