イメージを含むフッタを別のワードドキュメントにコピー

Question

フッタをあるワードドキュメントから別のドキュメントにコピーするマクロがありますが、これは完全に動作しますが、正確に同じ位置を保持しません - 同じフッタが必要ですmmまでこれを実現させるために、誰かが私の下のコードの修正を助けてくれますか？

Sub UpdateDocuments() 
    Application.ScreenUpdating = False 
    Dim strFolder As String, strFile As String, strDocNm As String 
    Dim wdDocSrc As Document, wdDocTgt As Document, HdFt As HeaderFooter 
    Dim aStory As Range 
    Dim aField As Field 
    Dim oldFilename As String 
    Dim bmRange As Range 
    Dim Response As Integer 
    Dim i As Long 
    Dim l As Integer 

THENフッターを置き換えるために実際のコードです（これはまた、フッターに文書の名前が追加されます）

or Each HdFt In .Sections.First.Footers 
    If HdFt.Exists Then 
     If wdDocSrc.Sections.First.Footers(HdFt.Index).Exists Then 
     HdFt.Range.FormattedText = wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText 

       'FILE NAME CODE 
       'Check if the DocName bookmark exists 
       If wdDocTgt.Bookmarks.Exists("DocName") = True Then 
       'If DocName bookmark does exist do this 
       Set bmRange = wdDocTgt.Bookmarks("DocName").Range 
         'NEW gets the name of the target document and removed the .doc extension 
         oldFilename = wdDocTgt.Name 
         If Right(oldFilename, 5) = ".docx" Then 
         oldFilename = Left(oldFilename, Len(oldFilename) - 5) 
          ElseIf Right(oldFilename, 4) = ".doc" Then 
          oldFilename = Left(oldFilename, Len(oldFilename) - 4) 

       'Update bmRange (DocName bookmark) with the file name with no extension 
       bmRange.Text = oldFilename 
         End If 
       End If 

       If wdDocTgt.Bookmarks.Exists("DocName2") = True Then 
       'If DocName bookmark does exist do this 

       Set bmRange = wdDocTgt.Bookmarks("DocName2").Range 
       'set bmRange as blank so as to no duplicate the name 
       bmRange.Text = " " 
        'NEW gets the name of the target document and removed the .doc extension 
         oldFilename = "" 
         oldFilename = wdDocTgt.Name 
         If Right(oldFilename, 5) = ".docx" Then 
         oldFilename = Left(oldFilename, Len(oldFilename) - 5) 
          ElseIf Right(oldFilename, 4) = ".doc" Then 
          oldFilename = Left(oldFilename, Len(oldFilename) - 4) 

       'Update bmRange (DocName bookmark) with the file name with no extension 
       bmRange.Text = oldFilename 
       End If 
      End If 
      'END FILE NAME CODE 

     End If 
    End If 

Answer 1

私は次のように問題を解決した：

wdDocTgt.PageSetup.FooterDistance = wdDocSrc.PageSetup.FooterDistance