第一章（宏）2018-6-2

413191246se

* 自动编号，无需人工检查。
* 第一章/第1章，汉字/数字类型任选。
* 默认全文查找：第一章/第一条，也可自定义：第一节/课/题/部分/阶段/自然段/律师事务所。
* 选定第一章，右键快捷菜单“选择相似的文本”可设置格式（想省墨可不加粗/或设为仿宋）。
* 程序速度较慢，运行期间请勿动键盘和鼠标。*
* 本宏<全文>查找《第一章》，如果想查找<选定区域>中的《第一章》，请应用20楼代码。

*

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("请输入量词！" & vbCr & "(比如：第一节的<节>，第一部分的<部分>)", "第一章/第一条", "节")
   
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. 
    
21.     With Selection
    
22.         .HomeKey unit:=wdStory
    
23.         With .Find
    
24.             .ClearFormatting
    
25.             .Replacement.Text = ""
    
26.             Do While .Execute("^13第[一二三四五六七八九十0-9０-９百零〇○Oo千]{1,}" & j, , , 1, , , 1)
    
27.                 With .Parent
    
28.                     If Not .Information(12) Then
    
29.                         .MoveStart 1, 1
    
30.                         .Expand 4
    
31.                         With .Find
    
32.                             .Execute " ", , , 0, , , , , , "", 2
    
33.                             .Execute "　", , , 0, , , , , , "", 2
    
34.                             .Execute "^t", , , 0, , , , , , "", 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.                             End With
    
45.                         Else
    
46.                             .Style = wdStyleSubtitle
    
47.                             If Len(j) > 1 Then .Font.Size = 18
    
48.                             .Font.NameFarEast = "黑体"
    
49.                             With .ParagraphFormat
    
50.                                 .SpaceBefore = 24
    
51.                                 .SpaceAfter = 24
    
52.                             End With
    
53.                             If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
    
54.                             If .Text Like "*　???" Then .Characters.Last.Previous.InsertBefore Text:=Chr(-24159)
    
55.                             .MoveEnd 1, -(Len(.Text) - (InStr(.Text, j) + Len(j) - 1))
    
56.                         End If
    
57.                         .MoveStart 1, 1
    
58.                         .MoveEnd 1, -Len(j)
    
59.                         i = i + 1
    
60.                         .Text = i
    
61.                         If n = 2 Then
    
62.                             .Delete
    
63.                             .Fields.Add Range:=.Range, Text:="= " & i & " \* CHINESENUM3"
    
64.                             .Paragraphs(1).Range.Fields.Unlink
    
65.                         End If
    
66.                     Else
    
67.                         .Tables(1).Range.Next.Select
    
68.                         If Asc(.Text) <> 13 Then .InsertParagraphBefore
    
69.                         .Characters(1).Font.Size = 4
    
70.                     End If
    
71.                     .EndKey 5
    
72.                 End With
    
73.             Loop
    
74.         End With
    
75.     End With
    
76. End Sub

复制代码

ming0018

抢个沙发，楼主试一下用range不要再用selection了。

天空飘过啥

不需要全文处理，只要选择范围内，改如何改。

413191246se

——谢 0018！过去 loquat 老师 也曾几次建议过我，少用 Selection/Select，多用 Range，这次由于匆忙，未考虑 Range，但前些天，我全文查找标题2时，发现，顶属 Selection 查找最快，本次确实未测试用多种方法完成后测试运行时间。
——谢 天空！要想给选定范围内数量词编号，得用到 Range 了，但为什么不全文处理呢？你确实需要吗？
——本次的宏，全文查找设置，方法是用 Selection 循环查找，功能完成，水平有限，算法一般。

菜菜行者

部分人是需要选择区域替换的

ming0018

413191246se 发表于 2018-5-30 23:50
——谢 0018！过去 loquat 老师 也曾几次建议过我，少用 Selection/Select，多用 Range，这次由于匆忙，未 ...

selection速度慢很多，我测过了，量小看不出来，几百页的文档，差距就出来了。
多交流，算法和思路提高的很快。

413191246se

    ming0018 你好！最近，我注意到你是一位新人，但水平可不低！可与 杜先生 等高人媲美！
我做此宏，说实话，做了两天，前天，是用 数组 默认把“章、条、节、课、题、部分、阶段”等一网打尽，但经过思考，我昨天改成了“第一章、第一条、自定义”三种选择，因为我个人实际上很少用到 第一X。
    我做测试时用的 demo 只有1页，有时2、3页，感觉 Selection 法最快，至于上百页，我没测试过。另外，限于水平较低，算法思路一般，只图完成功能便可。
    最近一直忙于 Word 2003 VBA 自动排版，主要是公文排版，又由于水平太低，致使很多天以来，进展不大。曾经得到过比如 守柔版主、龚先生(CuteWord)、杜先生(duquancai)、zhanglei 老师、loquat 等老师的指教，非常感激不尽。
    我下午把我最近的更新代码发到你的QQ邮箱，希望能得到指教、指正，谢谢！
    不知我的 Word 2003 VBA 代码，在你的 2013 上能否正确执行呢？

413191246se

邮件已发送，不知收到没有？如果收到，请参阅其中，批评指正，谢谢！

ming0018

413191246se 发表于 2018-5-31 14:15
邮件已发送，不知收到没有？如果收到，请参阅其中，批评指正，谢谢！

已收到。……。。……。……。……。…………

ming0018

413191246se 发表于 2018-5-31 11:19
ming0018 你好！最近，我注意到你是一位新人，但水平可不低！可与 杜先生 等高人媲美！
我做此宏，说 ...

加我QQ吧，我现在是做期刊图书排版的，希望可以和你多交流。