用VBA 批量给文档每节设置不同的页眉页脚

weiyingde

要求：
文档共有12页，每节标头不同，要求批量给不同的节插入不同的页眉和页脚。
例如：
第一节的页眉文字为：第一节标头
第一节的页脚为：第一节标头 & 第1页（或 第2页，第3页……）
模拟效果见附件中的“目标.docm”
附件如下

weiyingde

再请大侠一看，给与指点。

413191246se

魏老师：页眉和页脚这块，我也不太会。我从《VBA从入门到精通第二版》（PDF）这本电子书里截图了页眉和页脚相关知识，你有空看看吧，看能否帮上忙。
VBA-页眉和页脚.rar (631.56 KB, 下载次数: 239)

2019-1-1 12:10 上传

点击文件名下载附件

weiyingde

413191246se 发表于 2019-1-1 12:10
魏老师：页眉和页脚这块，我也不太会。我从《VBA从入门到精通第二版》（PDF）这本电子书里截图了页眉和页脚 ...

无论怎样还是感谢你，谢谢你的热心。

weiyingde

我自己借鉴别人的代码，琢磨了一下，还是没有达到理想结果。代码如下：
Sub 批量设置页眉页脚()
For i = 1 To ActiveDocument.Sections.Count
    If i Mod 2 <> 0 Then
      With ActiveDocument.Sections(i)
          .Headers(1).LinkToPrevious = False
          With .Headers(wdHeaderFooterPrimary).Range
            .Text = ActiveDocument.Sections(i).Range.Text
          End With
          .Footers(1).LinkToPrevious = False
          With .Footers(wdHeaderFooterPrimary).Range '.Frames(1).Range
            .InsertBefore ActiveDocument.Sections(i).Range.Text
            .InsertBefore "第"
            .InsertAfter "页"
            .Font.NameAscii = .Font.NameFarEast
            .ParagraphFormat.RightIndent = 14
            .ParagraphFormat.LeftIndent = 14
          End With
       End With
     End If
Next
End Sub

weiyingde

再改为下列代码，好一点点，还是没有达到理想效果，再次请求达人指点。
Sub 批量设置页眉页脚()
    For Each oSec In ActiveDocument.Sections
         Set myRange = oSec.Headers(wdHeaderFooterPrimary).Range
         myRange.Delete '删除页眉中的内容
         myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone '段落下边框线
         Set rng = oSec.Footers(wdHeaderFooterPrimary).Range
         rng.Delete '删除页脚中的内容
    Next
For i = 1 To ActiveDocument.Sections.Count
    If i Mod 2 <> 0 Then
      With ActiveDocument.Sections(i)
          With .Headers(wdHeaderFooterPrimary)
            .LinkToPrevious = False
            .Range.Text = Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
          End With
          With .Footers(wdHeaderFooterPrimary)
               .LinkToPrevious = False
             With .Range  '.Frames(1)
                  .InsertBefore Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
                  .InsertBefore "第"
                  .InsertAfter "页"
                  .Font.NameAscii = .Font.NameFarEast
                  .ParagraphFormat.RightIndent = 14
                  .ParagraphFormat.LeftIndent = 14
            End With
          End With
       End With
     End If
Next
End Sub

weiyingde

再次优化，但还是没有页码显示。再次求救大侠指点。

Sub 批量设置页眉页脚()
    For Each oSec In ActiveDocument.Sections
         Set myRange = oSec.Headers(wdHeaderFooterPrimary).Range
         myRange.Delete '删除页眉中的内容
         myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone '段落下边框线
         Set rng = oSec.Footers(wdHeaderFooterPrimary).Range
         rng.Delete '删除页脚中的内容
    Next
For i = 1 To ActiveDocument.Sections.Count
    If i Mod 2 <> 0 Then
      With ActiveDocument.Sections(i)
          With .Headers(wdHeaderFooterPrimary)
            .LinkToPrevious = False
            .Range.Text = Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
          End With
          With .Footers(wdHeaderFooterPrimary)
               .LinkToPrevious = False
             With .Range  '.Frames(1)
                  .InsertBefore "第"
                  .InsertBefore Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
                  .InsertAfter "页"
                  .Font.NameAscii = .Font.NameFarEast
                  .ParagraphFormat.RightIndent = 14
                  .ParagraphFormat.LeftIndent = 14
            End With
          End With
       End With
     End If
Next
End Sub

weiyingde

再进一步优化，现在还有两个问题；
1、页眉中为什么含有分页符，如何做到其中不含呢？
2、为什么“页”跑到了前面去了，而且和后面的隔断了？
代码如下，请大侠进一步优化。
Sub 批量设置页眉页脚()
    For Each oSec In ActiveDocument.Sections
         Set myRange = oSec.Headers(wdHeaderFooterPrimary).Range
         myRange.Delete '删除页眉中的内容
         myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone '段落下边框线
         Set rng = oSec.Footers(wdHeaderFooterPrimary).Range
         rng.Delete '删除页脚中的内容
    Next
For i = 1 To ActiveDocument.Sections.Count
    If i Mod 2 <> 0 Then
      With ActiveDocument.Sections(i)
          With .Headers(wdHeaderFooterPrimary)
            .LinkToPrevious = False
            .Range.Text = Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
          End With
          With .Footers(wdHeaderFooterPrimary)
               .LinkToPrevious = False
               .PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=True
             With .Range  '.Frames(1)
                  .InsertBefore "第"
                  .InsertBefore Left(ActiveDocument.Sections(i).Range.Text, Len(ActiveDocument.Sections(i).Range.Text) - 2)
                  .InsertAfter "页"
                  .Font.NameAscii = .Font.NameFarEast
                  .ParagraphFormat.RightIndent = 14
                  .ParagraphFormat.LeftIndent = 14
            End With
          End With
       End With
     End If
Next
End Sub

yhs185

分节符---连续    换成 分节符----下一页    试一试

jiangxiaoyun