第一章（集成扩展宏）2020-8-15

413191246se

* 应用本宏前，请一定要进行公文排版或普通排版（因为“第”字前有空格会找不到）。
* 既可添加"节/课/题/阶段/自然段"等量词；也可将n=0改为n=1查找《第1章》格式。
* 亮点：无论第一章/第一条/第一部分，均可自动设置格式、自动编号，无需手动。

1. Sub 第一章()
   
2. '集成扩展宏/第1行可添加<节/课/题/阶段/自然段>等/第3行若n=1将查找<第1章>
   
3.     Const s As String = "章/条/部分"
   
4.     Dim arr, i&, j&, n&
   
5.     n = 0
   
6.     arr = Split(s, "/")
   
7.     For j = 0 To UBound(arr)
   
8.         With ActiveDocument.Content.Find
   
9.             .ClearFormatting
   
10.             .Text = "^13第[一二三四五六七八九十百零千〇○OoＯｏ0-9０-９]@" & arr(j)
    
11.             .Forward = True
    
12.             .MatchWildcards = True
    
13.             Do While .Execute
    
14.                 i = i + 1
    
15.                 With .Parent
    
16.                     With ActiveDocument.Range(Start:=.Start + 1, End:=.End - Len(arr(j)))
    
17.                         .Delete
    
18.                         If n = 0 Then
    
19.                             .Fields.Add Range:=.Paragraphs(1).Range, Text:="= " & i & " \* CHINESENUM3"
    
20.                             .Fields.Unlink
    
21.                         Else
    
22.                             .InsertBefore Text:=i
    
23.                         End If
    
24.                         .InsertBefore Text:="第"
    
25.                         With .Paragraphs(1).Range
    
26.                             With .Find
    
27.                                 .Execute "^w", , , , , , , , , "", 2
    
28.                                 .Execute " ", , , , , , , , , "", 2
    
29.                             End With
    
30.                             .Characters(InStr(.Text, arr(j)) + Len(arr(j)) - 1).InsertAfter Text:=Chr(-24159)
    
31.                             If arr(j) = "条" Then
    
32.                                 If .Text Like "*[!。]?" Then .Characters.Last.InsertBefore Text:="。"
    
33.                                 With ActiveDocument.Range(Start:=.Start, End:=.Characters(InStr(.Text, arr(j))).End).Font
    
34.                                     .NameFarEast = "黑体"
    
35.                                     .NameAscii = "Times New Roman"
    
36.                                     .Bold = True
    
37.                                     .Color = wdColorPink
    
38.                                 End With
    
39.                             Else
    
40.                                 If .Text Like "*。?" Then .Characters.Last.Previous.Delete
    
41.                                 If Len(.Text) - (InStr(.Text, arr(j)) + Len(arr(j)) - 1) = 4 Then .Characters.Last.Previous.InsertBefore Text:=Chr(-24159)
    
42.                                 With .Font
    
43.                                     .NameFarEast = "黑体"
    
44.                                     .NameAscii = "Arial"
    
45.                                     .Size = 16
    
46.                                     .Bold = True
    
47.                                     If j = 0 Then
    
48.                                         .Color = wdColorRed
    
49.                                     Else
    
50.                                         .Color = wdColorGreen
    
51.                                         If Len(arr(j)) > 1 Then .Size = 18
    
52.                                     End If
    
53.                                 End With
    
54.                                 With .ParagraphFormat
    
55.                                     .CharacterUnitFirstLineIndent = 0
    
56.                                     .FirstLineIndent = CentimetersToPoints(0)
    
57.                                     .Alignment = wdAlignParagraphCenter
    
58.                                     .SpaceBefore = 30
    
59.                                     .SpaceAfter = 24
    
60.                                 End With
    
61.                             End If
    
62.                         End With
    
63.                     End With
    
64.                 End With
    
65.             Loop
    
66.         End With
    
67.         i = 0
    
68.     Next
    
69. End Sub

复制代码

413191246se

略。。。。

ming0018

占楼，此贴要火！

413191246se

谢谢 ming 老师 吉言！（最近好久不见啊！？）

413191246se

top.........