** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Word
  Mensajes nuevos Mensajes nuevos RSS - VBA Reemplazar fecha de cabecera
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA Reemplazar fecha de cabecera

 Responder Responder
Autor
Mensaje
solaire Ver desplegable
Nuevo
Nuevo


Unido: 11/Febrero/2015
Localización: Pamplona
Estado: Sin conexión
Puntos: 3
Enlace directo a este mensaje Tema: VBA Reemplazar fecha de cabecera
    Enviado: 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
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3291
Enlace directo a este mensaje Enviado: 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

Arriba
solaire Ver desplegable
Nuevo
Nuevo


Unido: 11/Febrero/2015
Localización: Pamplona
Estado: Sin conexión
Puntos: 3
Enlace directo a este mensaje Enviado: 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
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable