向多页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

---

根据文档的页眉/页脚设置，您需要将页眉/页脚添加到第一页的

wdheaderfooterfirfirstpage

范围中，并将所有其他页面的页眉/页脚添加到

wdheaderfooterprismary

下面的示例在所有页面中创建一个标题，由一个包含两个单元格的表组成。左边是图像，右边是文本

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