Код VBA для изменения нижнего колонтитула в нескольких файлах в зависимости от номера страницы

Question

У меня есть макрос, который запускается, чтобы заставить одну страницу сделать c в 5-страничную работу c (Дубликаты 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

Проблема с использованием mailmerge с вашей конструкцией поля заключается в том, что он конвертируется в результат. Попробуйте поле, закодированное как:

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

Теперь, если вы создайте необходимые 5 страниц в главном документе mailmerge, все выходные данные будут также кратны 5 страницам с правильной нумерацией страниц.

Даже если вы используете основной документ mailmerge только с одной страницей, Выходные данные будут иметь кодировку поля, необходимую для получения правильной нумерации для всех других страниц, которые вы хотите добавить к выходным данным.

Что касается репликации этого в существующих файлах, просто создайте документ с требуемым содержимым нижнего колонтитула, затем используйте макрос, например:

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