如何使用 VBA 将页码字段逻辑插入 Word 模板的页脚？

Posted 2023-03-21

【中文标题】如何使用 VBA 将页码字段逻辑插入 Word 模板的页脚？

【英文标题】：How can I insert page numbering field logic into a footer on my Word template using VBA?

【发布时间】：2019-08-26 21:50:18

【问题描述】：

我有一个 word 模板，它根据部分使用不同的页脚字段。有时，此模板的用户会弄乱页脚，因此我正在编写一个宏来通过放回默认页脚字段来修复页脚。 页脚字段根据部分有一些字段逻辑，基本上我需要执行以下操作：

从第 5 节重新开始页码

根据以下部分将文本插入第 1 行第 2 列页脚的表格中

第 1 至 4 节： PAGE //注意这是罗马数字格式，页脚设置了“不同的第一页”选项

第 5 节以后 if page

我已经成功完成了第一步并为第 1 到 4 节插入了字段，但是我正在努力解决如何以编程方式将第 5+ 节的复杂字段逻辑插入到我的模板中的相关页脚中VBA？ 我需要的代码在下面的代码块中注释为： '这里需要代码才能将以下字段逻辑插入到页脚中

Sub FixPageNumbering()

    Dim intSect As Integer

   On Error Resume Next

    'Insert footer code for Sections 1-4 into row1,col1 of 2x2 table
    For intSect = 1 To 4

        With ActiveDocument.Sections(intSect).Footers(wdHeaderFooterPrimary)
            .PageNumbers.NumberStyle = wdPageNumberStyleLowercaseRoman
            .Range.Tables(1).Rows(1).Cells(2).Select
            Selection.TypeText Text:="Page "
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
            "PAGE ", PreserveFormatting:=True
        End With
    Next intSect

    'Set page numbering to restart at #1 from Section 5
    With ActiveDocument.Sections(5).Footers(wdHeaderFooterPrimary).PageNumbers
     .RestartNumberingAtSection = True
     .StartingNumber = 1
    End With

    'Insert footer code for Sections 5 and onwards into row1,col1 of 2x2 table
    For intSect = 5 To ActiveDocument.Sections.Count
        With ActiveDocument.Sections(intSect).Footers(wdHeaderFooterPrimary)
            .PageNumbers.NumberStyle = wdPageNumberStyleArabic
            .Range.Tables(1).Rows(1).Cells(2).Select

            'NEED CODE HERE TO INSERT THE FOLLOWING FIELD LOGIC INTO FOOTER
            ' if  page  <  =  pageref ReferencesEnd  + 1  "Page  =  page   of  =  pageref ReferencesEnd " "Styleref "Att-Appendix Heading" \n "

          End With

    Next intSect

    ActiveWindow.View.Type = wdPrintView


End Sub

对于第 5 节及以后的部分，页脚字段应显示 & 的第 # 页，或者当有附录时（对于 ReferencesEnd 书签之后存在的页面），它将显示“附录 #”

【问题讨论】：

你在这里问什么？您是否要求所有域代码逻辑，正如问题似乎暗示的那样？或者只是为了代码的注释部分？如果是后者，请参阅***.com/q/49804968/3077495。但是您可能需要考虑将整个域代码作为 Building Block 存储在模板中，然后只需根据需要插入 Building Block。

嗨 Cindy - 澄清一下，我想问一下我需要在上面的代码中添加哪些额外代码来替换我评论为的位：“需要在此处插入以下代码” FIELD LOGIC INTO FOOTER' 我看过你链接到的文章，虽然它看起来可以提供一个解决方案，但我很难弄清楚我将在哪里开始使用它来插入我的字段逻辑，即 if page

【参考方案1】：

虽然可以通过 VBA 创建复杂的字段结构，但您最好将所需的字段代码存储在源文档中的两个单独段落中，您的宏可以从中复制并粘贴到目标中的适当位置文件。使用这种方法，您可能会使用如下代码：

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Dim i As Long, Rng As Range, HdFt As HeaderFooter
Set DocSrc = ThisDocument
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the target file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocTgt = Documents.Open(.SelectedItems(1))
  Else
    MsgBox "No target file selected. Exiting", vbExclamation
    GoTo ErrExit
  End If
End With
With DocTgt
  For i = 1 To .Sections.Count
    Select Case i
      Case 1 To 4: Set Rng = DocSrc.Paragraphs(1).Range
      Case Else: Set Rng = DocSrc.Paragraphs(2).Range
    End Select
    With .Sections(i)
      For Each HdFt In .Footers
        With HdFt
          If .Exists Then
            If .LinkToPrevious = False Then
              .Range.FormattedText = Rng.FormattedText
              .Range.Characters.Last.Delete
            End If
          End If
        End With
      Next
    End With
  Next
End With
ErrExit:
Set Rng = Nothing: Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

如有必要，尽管看起来不太可能，但您可以用代码补充上述代码以应用所需的编号格式 - 或者您可以将适当的开关添加到域代码本身。

PS：您的第二个域代码可以简化为-

IFPAGE< =PAGEREF ReferencesEnd+1 "Page PAGE of PAGEREF ReferencesEnd" STYLEREF "Att-Appendix Heading" \n

【讨论】：

嗨，macropod，非常感谢。不幸的是，使用其他文档不是我们现在想要使用的选项 - 所以我想看看在模板代码中部署它。

否则这将是一个优雅的解决方案 - 因为我假设复制范围也会跨字段复制？无论如何，如果您对如何将域代码直接插入页脚有其他想法，那就太棒了。

实际上是 macropod - 您提出的解决方案确实给了我一个想法，即在我的文档中包含页脚字段，但只需将它们隐藏在书签位置。然后，我可以稍后将其复制并粘贴到页脚位置。这一切都很好。感谢您的想法！

【参考方案2】：

如前所述，可以通过 VBA 创建复杂的字段结构。对于这种方法，您可以使用如下代码：

Sub Demo()
Application.ScreenUpdating = False
Dim DocTgt As Document, StrCode As String
Dim i As Long, Rng As Range, HdFt As HeaderFooter
With ActiveDocument
  For i = 1 To .Sections.Count
    Select Case i
      Case 1 To 4
        With .Sections(i)
          For Each HdFt In .Footers
            With HdFt
              If .Exists Then
                With .PageNumbers
                  .NumberStyle = wdPageNumberStyleLowercaseRoman
                  .RestartNumberingAtSection = False
                End With
                If .LinkToPrevious = False Or i = 1 Then
                  .Range.Fields.Add .Range, wdFieldEmpty, "PAGE", False
                End If
              End If
            End With
          Next
        End With
      Case Else:
        With .Sections(i)
          For Each HdFt In .Footers
            With HdFt
              If .Exists Then
                If i = 5 Then
                  .LinkToPrevious = False
                  With .PageNumbers
                    .NumberStyle = wdPageNumberStyleArabic
                    .RestartNumberingAtSection = True
                    .StartingNumber = 1
                  End With
                Else
                  With .PageNumbers
                    .NumberStyle = wdPageNumberStyleArabic
                    .RestartNumberingAtSection = False
                  End With
                End If
                If .LinkToPrevious = False Then
                  With .Range
                    .Fields.Add .Duplicate, wdFieldEmpty, "IF<  ""Page  of """, False
                    Set Rng = .Duplicate
                    With Rng
                      .Start = .Start + 19
                      .Collapse wdCollapseStart
                      .Fields.Add .Duplicate, wdFieldEmpty, "STYLEREF ""Att-Appendix Heading"" \n", False
                    End With
                    Set Rng = .Duplicate
                    With Rng
                      .Start = .Start + 17
                      .Collapse wdCollapseStart
                      .Fields.Add .Duplicate, wdFieldEmpty, "PAGEREF ReferencesEnd", False
                    End With
                    Set Rng = .Duplicate
                    With Rng
                      .Start = .Start + 13
                      .Collapse wdCollapseStart
                      .Fields.Add .Duplicate, wdFieldEmpty, "PAGE", False
                    End With
                    Set Rng = .Duplicate
                    With Rng
                      .Start = .Start + 6
                      .Collapse wdCollapseStart
                      .Fields.Add .Duplicate, wdFieldEmpty, "=+1", False
                      .Start = .Start + 3
                      .Collapse wdCollapseStart
                      .Fields.Add .Duplicate, wdFieldEmpty, "PAGEREF ReferencesEnd", False
                    End With
                    .Start = .Start + 4
                    .Collapse wdCollapseStart
                    .Fields.Add .Duplicate, wdFieldEmpty, "PAGE", False
                  End With
                End If
              End If
            End With
          Next
        End With
    End Select
  Next
End With
End Sub