【问题标题】:Copy a footer with image to another word document将带有图像的页脚复制到另一个 Word 文档
【发布时间】:2016-11-21 04:54:53
【问题描述】:

我有一个宏,可以将页脚从一个 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

【问题讨论】:

    标签: vba ms-word footer


    【解决方案1】:

    我发现以下解决了这个问题:

    wdDocTgt.PageSetup.FooterDistance = wdDocSrc.PageSetup.FooterDistance
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2014-09-22
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多