将页眉和页脚添加到多页Word文档VBA

我正在尝试通过宏向Word文档的每一页添加页眉和页脚。

我尝试了几种不同的方法，例如迭代页面上的每个形状，但在这种情况下，页眉和页脚会在每个页面上打印多次，具体取决于文档中的形状数量。

目前，我的代码正在查找任何当前的页眉和页脚并删除它们，然后它只是在第一页上插入我的页眉和页脚，并将文档页眉和页脚中的其余页面留空。

谁能告诉我哪里出错了？

Sub HeaderFooter()
    Dim oSec As Section
    Dim oHead As HeaderFooter
    Dim oFoot As HeaderFooter

    For Each oSec In ActiveDocument.Sections
        For Each oHead In oSec.Headers
            If oHead.Exists Then oHead.Range.Delete
        Next oHead

        For Each oFoot In oSec.Footers
            If oFoot.Exists Then oFoot.Range.Delete
        Next oFoot
    Next oSec

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    With Selection.PageSetup
        .HeaderDistance = CentimetersToPoints(1.0)
        .FooterDistance = CentimetersToPoints(1.0)
    End With
    Selection.InlineShapes.AddPicture FileName:="image.jpg" _
        , LinkToFile:=False, SaveWithDocument:=True
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.Font.Color = RGB(179, 131, 89)
    Selection.Font.Size = 10
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.TypeText Text:="footer test"      
End Sub

您需要将页眉/页脚添加到wdHeaderFooterFirstPage第一页的范围并进入wdHeaderFooterPrimary对于所有其他页面，具体取决于文档的页眉/页脚设置。

下面的示例在所有页面中创建一个标题，其中包含一个带有两个单元格的表格。左侧为图像，右侧为文本。

Sub UpdateHeader()

    Dim oDoc As Word.Document, oSec As Word.Section, rng As Word.Range
    Set oDoc = ActiveDocument

    For Each oSec In oDoc.Sections
        Set rng = oSec.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterFirstPage).Range
        AddHeaderToRange rng

        Set rng = oSec.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
        AddHeaderToRange rng
    Next oSec
End Sub


Private Sub AddHeaderToRange(rng As Word.Range)
    With rng
        .Tables.Add Range:=rng, NumRows:=1, NumColumns:=2, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:=wdAutoFitFixed
        With .Tables(1)
            .Borders.InsideLineStyle = wdLineStyleNone
            .Borders.OutsideLineStyle = wdLineStyleNone
            .Rows.SetLeftIndent LeftIndent:=-37, RulerStyle:=wdAdjustNone
            .Columns(2).SetWidth ColumnWidth:=300, RulerStyle:=wdAdjustNone
            .Cell(1, 1).Range.InlineShapes.AddPicture filename:="image path", LinkToFile:=False, SaveWithDocument:=True
            .Cell(1, 2).Range.Font.Name = "Arial"
            .Cell(1, 2).Range.Font.Size = 9
            .Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
            .Cell(1, 2).Range.Text = "Test header"
        End With
    End With
End Sub

同样的原则也适用于页脚。

Sub UpdateFooter()

    Dim oDoc As Word.Document, oSec As Word.Section, rng As Word.Range
    Set oDoc = ActiveDocument

    For Each oSec In oDoc.Sections
        Set rng = oSec.Footers(Word.WdHeaderFooterIndex.wdHeaderFooterFirstPage).Range
        AddFooterToRange rng

        Set rng = oSec.Footers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
        AddFooterToRange rng

        Set rng = oSec.Footers(Word.WdHeaderFooterIndex.wdHeaderFooterEvenPages).Range
        AddFooterToRange rng
    Next oSec
End Sub

Private Sub AddFooterToRange(rng As Word.Range)
    With rng
        .Font.Name = "Arial"
        .Font.Size = 9
        .Text = "Footer sample text"
        With .ParagraphFormat
            .Alignment = wdAlignParagraphJustify
            .LineSpacingRule = wdLineSpaceExactly
            .LineSpacing = Application.LinesToPoints(1)
            .LeftIndent = Application.CentimetersToPoints(-1.6)
            .RightIndent = Application.CentimetersToPoints(-1.6)
        End With
    End With
End Sub

最后，删除现有的标头：

Sub ClearExistingHeaders(oDoc As Word.Document)
    Dim oSec As Word.Section, oHeader As HeaderFooter
    For Each oSec In oDoc.Sections
        For Each oHeader In oSec.Headers
            oHeader.Range.Delete
        Next
    Next
End Sub