重排页码（宏）初探（封面+目录+正文，分节符分隔）

413191246se

1. Sub 重排页码()
   
2.     Dim i&, j&, k&
   
3. 
   
4.     If MsgBox("是否重排页码（否则顺延）？", 4 + 48) = vbYes Then k = 1
   
5. 
   
6.     With ActiveDocument
   
7.         j = .Sections.Count
   
8. 
   
9.         '第1节：封面，无页码！
   
10.         With .Sections(1)
    
11.             .Footers(wdHeaderFooterPrimary).Range.Delete
    
12.             .Headers(wdHeaderFooterPrimary).Range.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    
13.         End With
    
14. 
    
15.         '第2节：目录，有页码！格式：罗马数字
    
16.         With .Sections(2).Footers(wdHeaderFooterPrimary)
    
17.             .LinkToPrevious = False
    
18.             .Range.Delete
    
19.             With .PageNumbers
    
20.                 .NumberStyle = wdPageNumberStyleUppercaseRoman
    
21.                 .RestartNumberingAtSection = True
    
22.                 .StartingNumber = 1
    
23.                 .Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
    
24.             End With
    
25.             '*********************************
    
26.             With .Range.Font
    
27.                 .NameAscii = "Times New Roman"
    
28.                 .Size = 42
    
29.                 .Bold = True
    
30.                 .ColorIndex = wdRed
    
31.             End With
    
32.         End With
    
33. 
    
34.         '第3节：正文，有页码！格式：-1-/k=1：重排/k=0：顺延
    
35.         For i = 3 To j
    
36.             With .Sections(i).Footers(wdHeaderFooterPrimary)
    
37.                 If k = 1 Then
    
38.                     .LinkToPrevious = False
    
39.                 Else
    
40.                     .LinkToPrevious = True
    
41.                 End If
    
42.                 .Range.Delete
    
43.                 With .PageNumbers
    
44.                     .NumberStyle = wdPageNumberStyleNumberInDash
    
45.                     If k = 1 Then
    
46.                         .RestartNumberingAtSection = True
    
47.                     Else
    
48.                         .RestartNumberingAtSection = False
    
49.                     End If
    
50.                     .StartingNumber = 1
    
51.                     .Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
    
52.                 End With
    
53.                 '*********************************
    
54.                 With .Range.Font
    
55.                     .NameAscii = "Times New Roman"
    
56.                     .Size = 42
    
57.                     .Bold = True
    
58.                     .ColorIndex = wdBlue
    
59.                 End With
    
60.             End With
    
61.         Next
    
62.         If k = 0 Then
    
63.             With .Sections(3).Footers(wdHeaderFooterPrimary)
    
64.                 .LinkToPrevious = False
    
65.                 With .PageNumbers
    
66.                     .RestartNumberingAtSection = True
    
67.                     .StartingNumber = 1
    
68.                 End With
    
69.             End With
    
70.         End If
    
71.     End With
    
72. End Sub

复制代码

不经意的回头

感谢分享！

413191246se

谢谢 版主 大人 夸奖！再接再厉。

wjt_1221

楼主怎么用的，经常会用到。

王某某先生

感谢分享，有点疑问想咨询下，这里目录用罗马数字编码，从I开始，然后正文怎么是接着目录的编码继续的，虽然是阿拉伯数字。我看代码正文部分k=1也写了.RestartNumberingAtSection = True

413191246se

楼上朋友，你好！——请试验代码时自行准备示例文档，保存后调入试验。参照代码中的注释，分为几部分。运行宏后，可以有两种页码选择：顺延，还是 重排，请再试试。

梅州

谢谢分享，学习了

victorATV

很好用。谢谢分享。

barbison

弱弱的问下，页码可以改罗马数字为阿拉伯数字么？

413191246se

楼上朋友，可以改！请看第 20 行代码，和第 44 行代码，自行修改即可（.NumberStyle 数字样式）。