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