Word 2003 VBA 自动排版宏（集成版）更新：2019-3-22

413191246se

我的《集成版》设置标题2345的时候，包含了处理标题 4 的形如：“1、XX”（顿号）、“1.XX”（小数点）和“1．XX”（齐线墨点）三种情况均设置为第 3 种，即形如“1．XX”，和处理标题4/5为全角数字为半角的小程序（其实在《公文》宏中已经将全文半角括号全部替换为全角括号），处理后，才能正确处理标题2345四种标题层次，这点请注意。

leedun

413191246se 发表于 2019-3-31 23:27
leedun 朋友，你好！——你的示例文本弄丢了形如“（一）XX”和“1.XX”这两种标题层次，我也不知道你是怎 ...

感谢前辈，回家测试，以前用您和杜先生的代码已经能满足要求，正是觉得集成代码设置标题代码快才想要用新方法，另外在另一帖子请教的like问题，like "#."只能匹配10以下的编号，10以上的不行，因为有时候标题样式是如下格式的，不知道用like怎么做到。
x.
x.x
x.x.x
x.x.x.x

413191246se

1. Sub test多级编号标题设置()
   
2. '
   
3. '编号后面的点，到底是小数点(1.1)，还是齐线墨点(1．1)？我不清楚！有待商榷！
   
4. '
   
5. '多级编号设置参考 守柔版主 代码，倒着设置即可。
   
6. '
   
7. '其实用查找法也可以找到，暂时不考虑效率问题，用《循环遍历段落法》（For Each ... Next）是最简单的。
   
8. '
   
9. '请注意：只设置了样式，未设置过细的格式。标题2/3 均为 三号字，标题 4/5 均为 四号字
   
10. '
    
11. '既然提到 杜先生，我说一句：杜先生 去年前年为我编了好几个程序，我非常感谢他，也崇敬他！现在也是。
    
12. '但是，杜先生 给我编程的《标题2345自动设置》宏，即 Title2345Auto 宏，是有错误的！在我测试过程中发现有时不能正确设置！
    
13. '所以，我才抛开 杜先生 的正则表达式代码，自己用查找法设置标题2345；现在我已改为 ForEachNext 法，可以说是极快！
    
14. '
    
15.     With ActiveDocument
    
16.         '自动编号转文本
    
17.         .ConvertNumbersToText
    
18. 
    
19.         '多级编号后添加半角空格（也可改为全角。再加一个空格即为全角）
    
20.         With .Content.Find
    
21.             .Execute "(^13[0-9.]{1,})", , , 1, , , , , , "\1 ", 2
    
22.             .Execute "(^13[0-9.]{1,})([ 　^s^t]{1,})", , , 1, , , , , , "\1 ", 2
    
23.         End With
    
24. 
    
25.         '核心代码(颜色设置只为鲜明，不喜欢可屏蔽/删除)----具体为标题几请自行修改，即 wdStyleHeading5（标题5）可改为 3
    
26.         Dim i As Paragraph
    
27.         For Each i In ActiveDocument.Paragraphs
    
28.             With i.Range
    
29.                 If .Text Like "#.#.#.#*" Then
    
30.                     .Style = wdStyleHeading5
    
31.                     .Font.Color = wdColorOrange
    
32.                 ElseIf .Text Like "#.#.#*" Then
    
33.                     .Style = wdStyleHeading4
    
34.                     .Font.Color = wdColorGreen
    
35.                 ElseIf .Text Like "#.#*" Then
    
36.                     .Style = wdStyleHeading3
    
37.                     .Font.Color = wdColorPink
    
38.                 ElseIf .Text Like "#.*" Then
    
39.                     .Style = wdStyleHeading2
    
40.                     .Font.Color = wdColorRed
    
41.                 End If
    
42.             End With
    
43.         Next
    
44.     End With
    
45. End Sub

复制代码

leedun

413191246se 发表于 2019-4-2 00:13

前辈好，以前在网上看过类似代码，对于内容少的编号能够排版，但是对于编号超过10的还是没法设置。
10.xx
10.11xx
10.11.22xxx
12.xx
12.36xx
12.36.22xx

413191246se

leedun 你好！请试试下面代码：

1. Sub test多级标题()
   
2. '预处理
   
3.     With ActiveDocument
   
4.         '回车符/手动换行符=>段落标记
   
5.         .Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
   
6. 
   
7.         '删除所有域
   
8.         .Fields.Unlink
   
9. 
   
10.         '自动编号转文本
    
11.         .ConvertNumbersToText
    
12. 
    
13.         '多级编号后添加半角空格
    
14.         With .Content.Find
    
15.             .Execute "(^13[0-9.]{1,})", , , 1, , , , , , "\1 ", 2
    
16.             .Execute "(^13[0-9.]{1,})([ 　^s^t]{1,})", , , 1, , , , , , "\1 ", 2
    
17.         End With
    
18.     End With
    
19. 
    
20. '核心代码
    
21.     Dim r As Range
    
22.     With ActiveDocument.Content.Find
    
23.         .ClearFormatting
    
24.         .Text = "^13[0-9.]{1,}"
    
25.         .Forward = True
    
26.         .MatchWildcards = True
    
27.         Do While .Execute
    
28.             With .Parent
    
29.                 .MoveStart
    
30.                 Set r = .Paragraphs(1).Range
    
31.                 If .Text Like "*.*.*.*" Then
    
32.                     r.Style = wdStyleHeading5
    
33.                     r.Font.Color = wdColorOrange
    
34.                 ElseIf .Text Like "*.*.*" Then
    
35.                     r.Style = wdStyleHeading4
    
36.                     r.Font.Color = wdColorGreen
    
37.                 ElseIf .Text Like "*.?*" Then
    
38.                     r.Style = wdStyleHeading3
    
39.                     r.Font.Color = wdColorPink
    
40.                 ElseIf .Text Like "*." Then
    
41.                     r.Style = wdStyleHeading2
    
42.                     r.Font.Color = wdColorRed
    
43.                 End If
    
44.                 .Start = .End
    
45.             End With
    
46.         Loop
    
47.     End With
    
48. End Sub

复制代码

leedun

413191246se 发表于 2019-4-2 21:19
leedun 你好！请试试下面代码：

感谢前辈代码，明天测试一下

leedun

leedun 发表于 2019-4-3 19:34
感谢前辈代码，明天测试一下

章节和多级代码已测试，非常感谢

ghoob

感谢楼主分享

413191246se

谢谢大家！有需要的朋友请下载试用。

413191246se

* 我这个《集成版》中有一个宏叫《人民币中文大写》，还有一个宏叫《千分位》，只要会用 VBA，就可以应用这两个宏解决全文查找“数字元”（例如：357.49元）的问题，有些朋友可能还不知道。