第一章第一条（宏）for Word2003（最新）

413191246se

* 如果不想让文字有颜色，可查找本宏代码中的 Pink粉红/Red红色/Brown褐色 三行代码，屏蔽或注释掉即可。

1. Sub 第一章第一条()
   
2.     Dim i&, j$, k$, m$, n&
   
3.     k = MsgBox("<是>：第一章    <否>：第一条    <取消>：自定义", 3 + 48)
   
4.     If k = vbYes Then
   
5.         j = "章"
   
6.     ElseIf k = vbNo Then
   
7.         j = "条"
   
8.     Else
   
9.         j = InputBox("", "请输入量词（节/课/题/部分/阶段/自然段）", "部分")
   
10.         If j = "" Then End
    
11.     End If
    
12.     m = MsgBox("<是>：第一" & j & "    <否>：第1" & j & "    <取消>：放弃", 3 + 48)
    
13.     If m = vbYes Then
    
14.         n = 2
    
15.     ElseIf m = vbNo Then
    
16.         n = 1
    
17.     Else
    
18.         End
    
19.     End If
    
20.     With Selection
    
21.         .HomeKey Unit:=wdStory
    
22.         With .Find
    
23.             .ClearFormatting
    
24.             .Replacement.Text = ""
    
25.             Do While .Execute("^13第[一二三四五六七八九十0-9０-９百零〇○Oo千]{1,}" & j, , , 1, , , 1)
    
26.                 With .Parent
    
27.                     If Not .Information(12) Then
    
28.                         .MoveStart 1, 1
    
29.                         .Expand 4
    
30.                         With .Find
    
31.                             .Execute " ", , , , , , , , , "", 2
    
32.                             .Execute "　", , , , , , , , , "", 2
    
33.                             .Execute "^s", , , , , , , , , "", 2
    
34.                             .Execute "^t", , , , , , , , , "", 2
    
35.                         End With
    
36.                         .Characters(InStr(.Text, j) + Len(j) - 1).InsertAfter Text:=Chr(-24159)
    
37.                         If j = "条" Then
    
38.                             If .Text Like "*[!。：；，、！？…—.:;,!?]?" Then .Characters.Last.InsertBefore Text:="。"
    
39.                             .MoveEnd 1, -(Len(.Text) - InStr(.Text, j))
    
40.                             With .Font
    
41.                                 .NameFarEast = "黑体"
    
42.                                 .NameAscii = "Times New Roman"
    
43.                                 .Bold = True
    
44.                                 .Color = wdColorPink
    
45.                             End With
    
46.                         Else
    
47.                             .Style = wdStyleSubtitle
    
48.                             .Font.NameFarEast = "黑体"
    
49.                             .Font.Color = wdColorRed
    
50.                             If Len(j) > 1 Then .Font.Color = wdColorBrown
    
51.                             If Len(j) > 1 Then .Font.Size = 18
    
52.                             With .ParagraphFormat
    
53.                                 .SpaceBefore = 24
    
54.                                 .SpaceAfter = 30
    
55.                             End With
    
56.                             If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
    
57.                             If .Text Like "*　???" Then .Characters.Last.Previous.InsertBefore Text:=Chr(-24159)
    
58.                             .MoveEnd 1, -(Len(.Text) - (InStr(.Text, j) + Len(j) - 1))
    
59.                         End If
    
60.                         .MoveStart 1, 1
    
61.                         .MoveEnd 1, -Len(j)
    
62.                         i = i + 1
    
63.                         .Text = i
    
64.                         If n = 2 Then
    
65.                             .Delete
    
66.                             .Fields.Add Range:=.Range, Text:="= " & i & " \* CHINESENUM3"
    
67.                             .Paragraphs(1).Range.Fields.Unlink
    
68.                         End If
    
69.                     Else
    
70.                         .Tables(1).Range.Next.Select
    
71.                         If Asc(.Text) <> 13 Then .InsertParagraphBefore
    
72.                         .Characters(1).Font.Size = 4
    
73.                     End If
    
74.                     .EndKey 5
    
75.                 End With
    
76.             Loop
    
77.         End With
    
78.         .HomeKey Unit:=wdStory
    
79.     End With
    
80. End Sub

复制代码