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

Question

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

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

Text here {If{PAGE}="1""Original"{If{PAGE}="2""Copy 1"
{If{PAGE}="3""Copy 2"{If{PAGE}="4""Copy 3"{If{PAGE}="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

Answer 1

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

的字段

{={PAGE}-1 \# "'Copy {={PAGE}-1}';;'Original'"}

现在，如果您在 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

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

VBA Code to change word footer in multiple files based on page number

vba

ms-word

footer