ページ番号、ファイルパス、およびイメージを含むページフッターを挿入するにはどうすればよいですか？

Question

私はフッターをフォーマットしようとしています。そのため、フッタの右上にページ＃（xのうちのx）があり、次にイメージが中央に配置されます。私はページ＃のアルゴリズムを書いてしまい、上のイメージを挿入するためにインラインシェイプを使いました。問題は、テキストが画像の下にあり、画像が中央にないことです。どんな助けもありがとう。

.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

私は何かを試しました。私はそれが大きくなると思った。私はそれがあなたが到達したいものであなたを始めると確信しています。

"VBA to insert a modified Page x of y in a Word Footer"については、expert-exchange.comの協力がありました。私はテストをフィールドに変換するためにコードを使用しています。

「How to enable page numbers without affecting footers/headers」で述べたように、空の枠線を持つ表を使用する方法に従います。彼らはコンテンツを非常に正確に配置することができます。以下は

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

コードを見つける：以下のコードでは、3つの列を持つテーブルを挿入します理由です 。メインメソッド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