如何插入带有页码、文件路径和图像的页脚？

Posted 2023-03-21

【中文标题】如何插入带有页码、文件路径和图像的页脚？

【英文标题】：How to insert page footer with page numbers, file path and image?

【发布时间】：2018-01-02 08:22:33

【问题描述】：

我正在尝试格式化页脚，使其在页脚的右上角有页面 #（x 出 y），然后图像在下方居中。我最终为页面 # 编写了一个算法，然后使用 inlineshapes 插入上面的图像。问题是文本在图像下方并且图像未居中。任何帮助，将不胜感激。

.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

【问题讨论】：

你能提供一个小图应该如何放置图像吗？它应该位于页面的中心还是位于文本“page x out of y”下方？图片应该有多大？我很感兴趣你为什么在 VBA 中这样做？

我添加了一张图片。我只想要文档底部的图像。我相信它不需要重新缩放。我这样做是为了将公司的文档从 excel 转换为 word。它只是节省了将整个文档自动化的时间。

感谢菲利普的回答。我现在明白了。我仍然对图片的大小感兴趣。它影响页面和文件路径的放置位置。能否提供图片的高度（以厘米为单位）？

大概3cm左右

答案 (***.com/a/45388748/1306012) 对您有帮助吗？

【参考方案1】：

我已经解决了一些问题。它比我想象的要大。我相信它会让你开始你想要达到的目标。

experts-exchange.com 为他们的解决方案提供了一些帮助 “VBA to insert a modified Page x of y in a Word Footer”。我在代码中提到了它，我用它来将测试转换为字段。

正如您在另一个问题“How to enable page numbers without affecting footers/headers”中提到的那样，我遵循使用带有空边框的表格的方法。它们允许您非常准确地放置内容。 这就是为什么下面的代码会插入一个包含三列的表格：

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

在下面找到代码。主要方法 InsertFooter 您将要从您的代码中调用。它会做你想做的事：

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