VBA代码根据页码更改多个文件中的单词页脚

Posted 2023-03-21

【中文标题】VBA代码根据页码更改多个文件中的单词页脚

【英文标题】：VBA Code to change word footer in multiple files based on page number

【发布时间】：2020-05-21 16:51:14

【问题描述】：

我有一个宏，它可以将一个单页文档变成一个 5 页文档（NCR 副本），用于文件夹中的所有文件。

我在页脚中使用了一组嵌套的IF 字段，它根据页码更改页脚。该字段看起来像这样

Text here IfPAGE="1""Original"IfPAGE="2""Copy 1"
IfPAGE="3""Copy 2"IfPAGE="4""Copy 3"IfPAGE="5""Copy 4" 
Other Text

我正在尝试弄清楚如何将此页脚添加到文件夹中的所有文档中。如果有简单的基于页码的方法，则不需要使用字段。

我已经把头撞在墙上，像疯了一样搜索，现在拿起帽子。

复制的宏是：

Sub Make5CopiesNCR()

  vDirectory = BrowseForFolder

 vFile = Dir(vDirectory & "\" & "*.*")

Do While vFile <> ""

Documents.Open FileName:=vDirectory & "\" & vFile

MakeCopies

vFile = Dir
Loop

End Sub

End Sub

Private Sub MakeCopies()
Dim i As Integer
Selection.WholeStory
Selection.Copy
For i = 1 To 6
Selection.PasteAndFormat wdFormatOriginalFormatting
Next
With ActiveDocument
.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=6 'Page number
.Bookmarks("\Page").Select
With Selection
  .Delete
ActiveDocument.Close SaveChanges:=wdSaveChanges, OriginalFormat:=wdWordDocument
  End With
End With
End Sub

【问题讨论】：

如果您将每个页面设置为一个部分并取消第一部分和第二部分之间的页眉和页脚链接，那么您可以在第一页上将页脚简化为原始页。在第二部分重新开始编号，然后将 Copy pagenumber 作为页脚。

请使用问题下方的edit 链接来包含用于合并文档的代码。不太清楚你想要什么，因为如果页脚在第一个文档中并且其余部分被插入，它们应该自动继承第一页的页脚。如果这没有发生，我们需要准确了解您在做什么......

如果我不清楚，我深表歉意。我运行邮件合并来创建单个单词 doc 文件。然后我运行上面的代码在每个文件中创建 4 个额外的页面。我的最后一步是获取每个 5 页的文档，并读取第一页“原始”的页脚，然后是“副本 1”、“副本 2”等。我一直在做的是打开每个文档并粘贴嵌套的 if 语句来创建我需要的页脚。

【参考方案1】：

在字段构造中使用邮件合并的问题在于它会被转换为结果。尝试编码为的字段：

=PAGE-1 \# "'复制=PAGE-1';;'原创'"

现在，如果您在 mailmerge 主文档中创建所需的 5 页，则所有输出同样将是 5 页的倍数，并具有正确的页码。

即使您使用只有一个页面的邮件合并主文档，输出也将具有所需的字段编码，以便为您想要添加到输出的更多页面生成正确的编号。

至于在现有文件中复制此内容，只需创建一个包含所需页脚内容的文档，然后使用如下宏：

Sub ReplicateFooter()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Rng As Range
Dim StrPth As String, StrNm As String, StrSrc As String
Set DocSrc = ActiveDocument
Set Rng = DocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range
StrPth = DocSrc.Path & "\": StrSrc = DocSrc.FullName
StrNm = Dir(StrPth & "*.doc", vbNormal)
While StrNm <> ""
  If StrPth & StrNm <> StrSrc Then
    Set DocTgt = Documents.Open(FileName:=StrPth & StrNm, AddToRecentFiles:=False, Visible:=False)
    With DocTgt
      With .Sections.First.Footers(wdHeaderFooterPrimary).Range
        .FormattedText = Rng.FormattedText
        .Characters.Last.Text = vbNullString
      End With
      .Close True
    End With
  End If
  StrNm = Dir()
Wend
Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub