vba - tiempo - como poner numero de pagina en word por secciones

¿Cómo insertar el pie de página con los números de página, la ruta del archivo y la imagen?

Question

Estoy tratando de formatear el pie de página para que tenga la página # (x de y) en la parte superior derecha del pie de página, y luego la imagen centrada debajo. Terminé escribiendo un algoritmo para el número de página y luego usé las líneas en línea para insertar la imagen de arriba. El problema es que el texto está debajo de la imagen y la imagen no está centrada. Cualquier ayuda sería apreciada.

.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).range.Paragraphs.Alignment = wdAlignParagraphCenter ''Centers Header''
.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).range.InlineShapes.AddPicture ("X:/EQP/Residential Maintenance Agreement/Archived RMA templates/AA Logo Swoops cropped 2.JPG") ''Calls for image header''
.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).range.Paragraphs.Alignment = wdAlignParagraphCenter ''Centers Footer''
.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).range.InlineShapes.AddPicture ("X:/EQP/Residential Maintenance Agreement/Footer Template.PNG")
With wdapp.ActiveDocument.Sections(1).Footers(1).range.Paragraphs(1)
.range.InsertAfter vbCr & "Page "
Set r = .range
E = .range.End
r.Start = E
.range.Fields.Add r, wdFieldPage
.range.InsertAfter " of "
E = .range.End
r.Start = E
.range.Fields.Add r, wdFieldNumPages
.Alignment = wdAlignParagraphRight
''.Alignment = wdAlignParagraphCenter
''.range.InlineShapes.AddPicture ("X:/EQP/Residential Maintenance Agreement/Footer Template.PNG")
End With

Answer 1

He resuelto algo. Es más grande de lo que pensé que llegaría a ser. Estoy seguro de que te hace comenzar con lo que quieres alcanzar.

Hubo algo de ayuda de expertos-exchange.com con su solución sobre " VBA para insertar una página x de y modificada en Word Footer ". Lo mencioné en el código donde lo uso para convertir las pruebas en campos.

Como se menciona en su otra pregunta " Cómo habilitar los números de página sin afectar los pies de página / encabezados ", sigo el método para usar tablas con bordes vacíos. Le permiten colocar contenido muy exacto. Es por eso que el siguiente código insertará una tabla con tres columnas:

 ___________________ ________________________ ___________
|_Your footer text__|_Center part if needed__|_Page X/Y__|

A continuación encuentra el código. El método principal InsertFooter que querrás llamar desde tu código. Hará lo que desee:

Sub InsertFooter()
Dim footer As HeaderFooter
Dim footerRange As range
Dim documentSection As Section
Dim currentView As View
Dim footerTable As table
Dim pictureShape As Shape
On Error GoTo MyExit
'' Disable updating to prevent flickering
Application.ScreenUpdating = False
For Each documentSection In ActiveDocument.Sections
For Each footer In documentSection.Footers
If footer.Index = wdHeaderFooterPrimary Then
Set footerRange = footer.range
'' add table to footer
Set footerTable = AddTableToFooter(footerRange)
'' Make table border transparent
SetTableTransparentBorder footerTable
'' Insert page X out of Y into third column in table
InsertPageNumbersIntoTable footerTable
'' Insert file path
InsertFilePathIntoTable footerTable
'' Add picture to footer
AddPictureToFooter footerRange, "C:/Pictures/happy.jpg", 3
End If
Next footer
Next documentSection
MyExit:
'' Enable updating again
Application.ScreenUpdating = True
Application.ScreenRefresh
End Sub
Sub AddPictureToFooter(range As range, filePath As String, pictureHeightInCm As Single)
Set pictureShape = range.InlineShapes.AddPicture(FileName:=filePath, LinkToFile:=False, SaveWithDocument:=True).ConvertToShape
pictureShape.WrapFormat.Type = wdWrapFront
pictureShape.height = CentimetersToPoints(pictureHeightInCm)
pictureShape.Top = 0
End Sub
Sub InsertPageNumbersIntoTable(tableToChange As table)
'' Attention no error handling done!
'' inserts "Page {page} of {pages}" into the third column of a table
Dim cellRange As range
Set cellRange = tableToChange.Cell(1, 3).range
cellRange.InsertAfter "Page { PAGE } of { NUMPAGES }"
TextToFields cellRange
End Sub
'' Credits go to
'' https://www.experts-exchange.com/questions/23467589/VBA-to-insert-a-modified-Page-x-of-y-in-a-Word-Footer.html#discussion
Sub TextToFields(rng1 As range)
Dim c As range
Dim fld As Field
Dim f As Integer
Dim rng2 As range
Dim lFldStarts() As Long
Set rng2 = rng1.Duplicate
rng1.Document.ActiveWindow.View.ShowFieldCodes = True
For Each c In rng1.Characters
DoEvents
Select Case c.Text
Case "{"
ReDim Preserve lFldStarts(f)
lFldStarts(f) = c.Start
f = f + 1
Case "}"
f = f - 1
If f = 0 Then
rng2.Start = lFldStarts(f)
rng2.End = c.End
rng2.Characters.Last.Delete ''{
rng2.Characters.First.Delete ''}
Set fld = rng2.Fields.Add(rng2, , , False)
Set rng2 = fld.Code
TextToFields fld.Code
End If
Case Else
End Select
Next c
rng2.Expand wdStory
rng2.Fields.Update
rng1.Document.ActiveWindow.View.ShowFieldCodes = False
End Sub
Sub InsertFilePathIntoTable(tableToChange As table)
'' Attention no error handling done!
'' inserts "Page {page} of {pages}" into the third column of a table
Dim cellRange As range
Set cellRange = tableToChange.Cell(1, 1).range
cellRange.InsertAfter "{ FILENAME /p }"
TextToFields cellRange
End Sub
Sub SetTableTransparentBorder(tableToChange As table)
tableToChange.Borders(wdBorderTop).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderRight).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
tableToChange.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End Sub
Function AddTableToFooter(footerRange As range) As table
Dim footerTable As table
Set footerTable = ActiveDocument.Tables.Add(range:=footerRange, NumRows:=1, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
'' Algin third column to right
footerTable.Cell(1, 3).range.ParagraphFormat.Alignment = wdAlignParagraphRight
Set AddTableToFooter = footerTable
End Function