为多个 word 文档添加现有 Header 和页脚

Question

我在一个文件夹中有大约 1000 个 Word 文档，header 和页脚需要 added/changed（header 需要 added/changed 只是第一页） .

I found a very helpful VBA script 这是可行的，但我试过了，但无法根据我的需要设置样式和格式，如附图所示

Header我需要的风格

我需要的页脚样式

我在 Whosebug 中找到的工作代码：

Sub openAllfilesInALocation()
Dim Doc
Dim i As Integer

Dim docToOpen As FileDialog
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
    docToOpen.Show

For i = 1 To docToOpen.SelectedItems.Count
'Open each document
Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))

With ActiveDocument.Sections(1)
    .Headers(wdHeaderFooterPrimary).Range.Text = "Header goes here"
    .Footers(wdHeaderFooterPrimary).Range.Text = "Footer goes here"
End With

Doc.Save
Doc.Close

Next i

End Sub

提前感谢大家阅读 and/or 帮助我解决这个问题，因为如果我无法解决，我需要添加大约 1000 字的文档 header s 和页脚手动…… :( 所以感谢您的帮助或只是尝试！

Answer 1

在为此编写代码之前，您需要将任务分解为多个步骤。

打开您需要应用更改的文档之一。
在编辑 Header 样式时录制宏，使其具有正确的格式
在编辑页脚样式时录制宏，使其具有正确的格式
编辑文档的 header 以包含您需要的任何徽标和文本。
Select header 的内容并另存为 Building Block - 在 Header 和页脚选项卡上单击“Header”，然后“保存 Selection 到 Header 图库”。确保注意将其保存到哪个模板，因为稍后您需要知道这一点。
编辑文档的页脚以包含您需要的任何文本。 Select 页脚的内容并另存为构建基块 - 在 Header 和页脚选项卡上单击“页脚”，然后单击“将 Selection 保存到页脚库”。再次确保您注意将其保存到哪个模板。

现在您可以编写代码了。例如：

Sub openAllfilesInALocation()
   Dim Doc As Document
   Dim i As Integer
   
   Dim BBlockSource As Template
   Set BBlockSource = Application.Templates("<Full path to template you stored building blocks in>")
   
   Dim docToOpen As FileDialog
   Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
   docToOpen.Show

   For i = 1 To docToOpen.SelectedItems.Count
      'Open each document
      Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
      MacroToModifyHeaderStyle  'name of the macros you recorded in steps 2 & 3
      MacroToModifyFooterStyle
      With ActiveDocument.Sections(1)
         BBlockSource.BuildingBlockEntries("Name of Header Building Block").Insert .Headers(wdHeaderFooterFirstPage).Range
         BBlockSource.BuildingBlockEntries("Name of Footer Building Block").Insert .Footers(wdHeaderFooterFirstPage).Range
         'you may need the following if an extra paragraph is created when adding the building block
         '.Headers(wdHeaderFooterFirstPage).Range.Paragraphs.Last.Range.Delete
         '.Footers(wdHeaderFooterFirstPage).Range.Paragraphs.Last.Range.Delete
      End With

      Doc.Save
      Doc.Close

   Next i

End Sub

显然，您在尝试运行对所有文件进行测试之前，先在一些文件的副本上测试您的代码。

Answer 2

只需将以下宏添加到包含新 header 和页脚的文档，然后运行包含文件夹浏览器的宏，这样您就可以 select 要处理的文件夹.

Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDocSrc = ActiveDocument
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
    If strFolder & "\" & strFile <> wdDocSrc.FullName Then
        Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _
        AddToRecentFiles:=False, Visible:=False)
        With wdDocTgt
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.FormattedText
                            End If
                        End If
                    End With
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    With HdFt
                        If .Exists Then
                            If .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText
                            End If
                        End If
                    End With
                Next
            Next
            .Close SaveChanges:=True
        End With
    End If
    strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

按照编码，宏假定您从中运行调用宏的文档只有一个节，最多填充三个 header（Word 允许），并且目标文档中的所有 header 都将更新以匹配源文档的主要 header 和页脚。如果您只想更新第一节中的 headers，请删除页脚循环并删除 'For Each Sctn In .Sections'，然后在代码中删除 'Next' 并将 'For Each HdFt In Sctn.Headers' 更改为 'For Each HdFt In .Sections(1).Headers'.

为多个 word 文档添加现有 Header 和页脚

Adding existing Header and Footer for multiple word documents

vba

ms-word