将带有图像的页脚复制到另一个 word 文档

Copy a footer with image to another word document

我有一个宏,可以将页脚从一个 Word 文档复制到另一个文档 - 这非常有效,但它不能使定位完全相同 - 我需要一个页脚与 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

那么替换页脚的实际代码是(这还将文档的名称添加到页脚中)

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

我发现以下解决了问题:

wdDocTgt.PageSetup.FooterDistance = wdDocSrc.PageSetup.FooterDistance