word vba 怎么设置续上节

jurdy001

小生编了代码 但是在本机上运行得不到正确结果

本机系统 win10 64bit    vba：2016 32bit

渴望实现：（手动将光标置于正文第1节）用vba设置从正文第2节开始续前节（页眉 页脚）  同时 页码也要续前节（不能新节重新编号）

已有代码的问题：运行并不能保证续前节  有些则可以  一直找不到原因

jurdy001

刚刚忘了附件 如下

duquancai

jurdy001 发表于 2019-6-15 12:03
刚刚忘了附件 如下

很简单吧！         

jurdy001

老师 我编的代码就是不行  麻烦老师帮我看看哪里不对呀

duquancai

jurdy001 发表于 2019-6-15 12:03
刚刚忘了附件 如下

1. Sub main()
   
2.     Dim fag As Boolean, sec As Section
   
3.     If ActiveDocument.Sections.Count = 1 Then Exit Sub
   
4.     For Each sec In ActiveDocument.Sections
   
5.         If Not fag Then
   
6. '            设置好页眉
   
7. '            设置好页脚
   
8. '            设置好页码（包括设置好起始页码）
   
9.             fag = True
   
10.         Else
    
11. '            页眉，设置与上一节相同
    
12. '            页脚，设置与上一节相同
    
13. '            页码，设置续前节
    
14.         End If
    
15.     Next
    
16. End Sub

复制代码

jurdy001

duquancai 发表于 2019-6-15 12:53

Sub 设置链接页眉页脚且页码续上节()
Application.ScreenUpdating = False

Dim q As String
Dim n As Integer
Dim m As Integer
Dim i As Integer

q = MsgBox("该操作必须要将光标停留在正文的第1节！" & Chr(10) & "请确认是否如此？", vbYesNo, "系统询问")
If q = vbYes Then

n = Selection.Information(wdActiveEndSectionNumber)
m = ActiveDocument.Sections.Count


For i = n + 1 To m

With ActiveDocument.Sections(i)

    .Headers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
    .Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
   
    .Headers(wdHeaderFooterPrimary).LinkToPrevious = True
    .Footers(wdHeaderFooterPrimary).LinkToPrevious = True


End With

    With ActiveDocument.Sections(i).PageSetup


        .PageWidth = ActiveDocument.Sections(n).PageSetup.PageWidth
        .PageHeight = ActiveDocument.Sections(n).PageSetup.PageHeight

        .TopMargin = ActiveDocument.Sections(n).PageSetup.TopMargin
        .BottomMargin = ActiveDocument.Sections(n).PageSetup.BottomMargin
        .LeftMargin = ActiveDocument.Sections(n).PageSetup.LeftMargin
        .RightMargin = ActiveDocument.Sections(n).PageSetup.RightMargin

        .HeaderDistance = ActiveDocument.Sections(n).PageSetup.HeaderDistance
        .FooterDistance = ActiveDocument.Sections(n).PageSetup.FooterDistance

    End With
   

   
Next


MsgBox "设置完毕!"
End If
Application.ScreenUpdating = True
End Sub


老师 这是我的代码  运行就是不可靠

您那个 我运行好像也不行
（不好意思 刚刚出了些状况 附件并没有代码 ）

jurdy001

duquancai 发表于 2019-6-15 12:53

老师您好  您的代码我这边也不行  麻烦您看看我的代码哪里有缺陷
Sub 设置链接页眉页脚且页码续上节()
Application.ScreenUpdating = False

Dim q As String
Dim n As Integer
Dim m As Integer
Dim i As Integer

q = MsgBox("该操作必须要将光标停留在正文的第1节！" & Chr(10) & "请确认是否如此？", vbYesNo, "系统询问")
If q = vbYes Then
n = Selection.Information(wdActiveEndSectionNumber)
m = ActiveDocument.Sections.Count

For i = n + 1 To m
    With ActiveDocument.Sections(i)
   
        .Headers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
        .Footers(wdHeaderFooterPrimary).PageNumbers.RestartNumberingAtSection = False
        
        .Headers(wdHeaderFooterPrimary).LinkToPrevious = True
        .Footers(wdHeaderFooterPrimary).LinkToPrevious = True
   
    End With

    With ActiveDocument.Sections(i).PageSetup

        .PageWidth = ActiveDocument.Sections(n).PageSetup.PageWidth
        .PageHeight = ActiveDocument.Sections(n).PageSetup.PageHeight

        .TopMargin = ActiveDocument.Sections(n).PageSetup.TopMargin
        .BottomMargin = ActiveDocument.Sections(n).PageSetup.BottomMargin
        .LeftMargin = ActiveDocument.Sections(n).PageSetup.LeftMargin
        .RightMargin = ActiveDocument.Sections(n).PageSetup.RightMargin

        .HeaderDistance = ActiveDocument.Sections(n).PageSetup.HeaderDistance
        .FooterDistance = ActiveDocument.Sections(n).PageSetup.FooterDistance

    End With
  
Next
MsgBox "设置完毕!"
End If
Application.ScreenUpdating = True
End Sub

jurdy001

本条回复已被删除

duquancai

你这个问题充钱就能解决

xiaoyouxi01

Sub 续前节()
    Application.ScreenUpdating = False
    Dim oSection As Section, oHeaderFooter As HeaderFooter
    For Each oSection In ActiveDocument.Sections
        For Each oHeaderFooter In oSection.Headers
            oHeaderFooter.LinkToPrevious = True
        Next
        For Each oHeaderFooter In oSection.Footers
            oHeaderFooter.LinkToPrevious = True
        Next
        With oSection.Footers(wdHeaderFooterPrimary).PageNumbers
            .RestartNumberingAtSection = False
        End With
    Next
    Application.ScreenUpdating = True
End Sub