Question

我正在尝试通过宏向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

Answer 1

您需要将页眉/页脚添加到第一页的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

将页眉和页脚添加到多页面文字doc VBA

1 个答案: