公文标题2345自动设置（宏）——杜先生 请进！

413191246se

* 杜先生，请看代码中间星号（*）部分的问题，请指教：

1. Sub Title2345()
   
2. '更新--杜先生 此法最快！
   
3.     Dim mt, reg As Object, n&, m&, L&, ostr$, sr$, r1$, r2$, r3$, r4$, v As Range
   
4.     ostr = Replace(ActiveDocument.Content, Chr(7), "")
   
5.     sr = "一二三四五六七八九十百零千〇"
   
6.     r1 = "^[" & sr & "]+、"
   
7.     r2 = "^[(（]\s*[" & sr & "]+\s*[)）]"
   
8.     r3 = "^\d+[、.．]"
   
9.     r4 = "^[(（]\s*\d+\s*[)）]"
   
10.     Set reg = CreateObject("vbscript.regexp")
    
11.     With reg
    
12.         .Global = True
    
13.         .MultiLine = True
    
14.         .Pattern = "" & r2 & "|" & r1 & "|" & r4 & "|" & r3 & ""
    
15.         For Each mt In .Execute(ostr)
    
16.             m = mt.FirstIndex
    
17.             n = mt.Length
    
18.             With ActiveDocument.Range(m, m + n)
    
19.                 If Not .Information(wdWithInTable) Then
    
20.                     .Expand 4: L = Len(.Text): .Collapse
    
21.                     If .MoveWhile(sr, L) > 0 Then
    
22.                         .Expand 4
    
23.                         .Style = "标题 2"
    
24.                         .Font.ColorIndex = 6
    
25.                     ElseIf .MoveWhile("(（", L) > 0 Then
    
26.                         If .MoveWhile(sr, L) > 0 Then
    
27.                             .Expand 4
    
28.                             .Style = "标题 3"
    
29.                             With .Font
    
30.                                 .Name = "楷体"
    
31.                                 .Name = "Times New Roman"
    
32.                                 .ColorIndex = 5
    
33.                             End With
    
34.                         Else
    
35.                             .Expand 4
    
36.                             .Style = "标题 5"
    
37.                             With .Font
    
38.                                 .Name = "仿宋"
    
39.                                 .Name = "Times New Roman"
    
40.                                 .ColorIndex = 12
    
41.                             End With
    
42.                         End If
    
43.                     Else
    
44.                         .Expand 4
    
45.                         .Style = "标题 4"
    
46.                         With .Font
    
47.                             .Name = "仿宋"
    
48.                             .Name = "Times New Roman"
    
49.                             .ColorIndex = 11
    
50.                         End With
    
51.                     End If
    
52.                     If .Style <> "正文" Then
    
53.                         If .Sentences.Count = 1 Then
    
54.                             If ActiveDocument.Range(m, m + n) Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
    
55.                             '*********************************************************************************************************************************
    
56.                             '杜先生：上面这行语句，不像 i.Range 那样能删除段落（.Sentences.Count=1）末尾标点符号，不知道怎么办，请 杜先生 指教！
    
57.                             '如果改成 .Select:Selection 那样，则“一、XX；二、XX；三、XX都能正确设置，但：四、XX不能设置”；而且激活、选定后速度慢一倍多。
    
58.                             '*********************************************************************************************************************************
    
59.                         Else
    
60.                             With .Font
    
61.                                 .Name = "仿宋"
    
62.                                 .Name = "Times New Roman"
    
63.                                 .Bold = False
    
64.                                 .Color = wdColorBlue
    
65.                             End With
    
66.                             With .Sentences(1).Font
    
67.                                 .Bold = True
    
68.                                 .Color = wdColorBrown
    
69.                             End With
    
70.                         End If
    
71.                     End If
    
72.                     With .Font
    
73.                         .Size = 16
    
74.                         .Kerning = 0
    
75.                         .DisableCharacterSpaceGrid = True
    
76.                     End With
    
77.                     With .ParagraphFormat
    
78.                         .SpaceBeforeAuto = False
    
79.                         .SpaceAfterAuto = False
    
80.                         .SpaceBefore = 0
    
81.                         .SpaceAfter = 0
    
82.                         .LineSpacing = LinesToPoints(1.25)
    
83.                         .CharacterUnitFirstLineIndent = 2
    
84.                         .AutoAdjustRightIndent = False
    
85.                         .DisableLineHeightGrid = True
    
86.                         .KeepWithNext = False
    
87.                         .KeepTogether = False
    
88.                     End With
    
89.                 End If
    
90.             End With
    
91.         Next
    
92.     End With
    
93. End Sub

复制代码

相见是缘8

他可能生气了！

413191246se

等 杜先生 哪天高兴了，再回复我。

菜菜行者

生气？不存在

dsd999

杜先生是谁，很有名？

相见是缘8

dsd999 发表于 2018-3-26 17:07
杜先生是谁，很有名？

杜先生的网名好像是 “ duquancai ” ，该论坛 VBA 的顶级大神，没有他搞不定的！