第一章（宏）2018-6-2

413191246se

不好意思，已经不想用QQ了，有事在论坛里说吧，家里/单位均不安装QQ。另外，我水平低，虽然比你早到论坛几年（2011年7月来论坛的），但水平一直未提高多少，倒也有些进步，不过，仍然很低。
我建议你可以搞一套2013自动排版系统，以方便同样使用2013的朋友们。

ming0018

413191246se 发表于 2018-5-31 16:03
不好意思，已经不想用QQ了，有事在论坛里说吧，家里/单位均不安装QQ。另外，我水平低，虽然比你早到论坛几 ...

目前正在搞，同事已经开始用了。

413191246se

略。。。。。。。。。

天空飘过啥

ming0018 发表于 2018-5-31 16:08
目前正在搞，同事已经开始用了。

期待哪天能用上您的自动排版

天空飘过啥

楼主，能改成选择区域吗

413191246se

明晃晃的 13 楼回复，天空 竟然没看？？？

天空飘过啥

413191246se 发表于 2018-5-31 23:16
明晃晃的 13 楼回复，天空 竟然没看？？？

天啊，真不懂我看哪里去了，一晚上我刷新了很多次这帖子竟然没看到您的回复，哎，不好意思！

谢谢抽空为我解答，谢谢！

413191246se

    SORRY，天空！——我发完帖子也想了，是不是同一时间你没看到？另外，帖子发完，管理员要审核的，一般不会立即审核，所以，就耽误时间了，也是我着急了，误会解除。
    天空，你试试吧，我没测试大文本，只是能处理选定范围内的《第一章》（条）了。（如果选定范围内包括表格，结果不一定正确。）

413191246se

ming0018：今日我复制了一个50页的大文本demo，查找《第一条》，测试结果如下：
第一章Select=45.53'  第一章Range=58.54'
可以看出，Selection/Select 方法比 Range 方法快了 13 秒，和你的结果正好相反。

413191246se

1. Sub 第一章_选定区域()
   
2.     Dim i&, j$, k$, m$, n&, r As Range, s As Range, x&
   
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. 
    
13.     m = MsgBox("<是>：第一" & j & "    <否>：第1" & j & "    <取消>：放弃", 3 + 48, "请选择编号类型！")
    
14.     If m = vbYes Then
    
15.         n = 2
    
16.     ElseIf m = vbNo Then
    
17.         n = 1
    
18.     Else
    
19.         End
    
20.     End If
    
21. 
    
22.     With Selection
    
23.         If .Type = wdSelectionIP Then .WholeStory
    
24.         Set r = .Range
    
25.         Set s = .Range
    
26.     End With
    
27. 
    
28.     r.MoveStart 1, -1
    
29. 
    
30.     With r.Find
    
31.         .ClearFormatting
    
32.         .Replacement.Text = ""
    
33.         Do While .Execute("^13第[一二三四五六七八九十0-9０-９百零〇○Oo千]{1,}" & j, , , 1, , , 1)
    
34.             x = 1
    
35.             With .Parent
    
36.                 If Not .Information(12) Then
    
37.                     .MoveStart 1, 1
    
38.                     .Expand 4
    
39.                     With .Find
    
40.                         .Execute " ", , , 0, , , , , , "", 2
    
41.                         .Execute "　", , , 0, , , , , , "", 2
    
42.                         .Execute "^t", , , 0, , , , , , "", 2
    
43.                     End With
    
44.                     .Characters(InStr(.Text, j) + Len(j) - 1).InsertAfter Text:=Chr(-24159)
    
45.                     If j = "条" Then
    
46.                         If .Text Like "*[!。：；，、！？…—.:;,!?]?" Then .Characters.Last.InsertBefore Text:="。"
    
47.                         .MoveEnd 1, -(Len(.Text) - InStr(.Text, j))
    
48.                         With .Font
    
49.                             .NameFarEast = "黑体"
    
50.                             .NameAscii = "Times New Roman"
    
51.                             .Bold = True
    
52.                         End With
    
53.                     Else
    
54.                         .Style = wdStyleSubtitle
    
55.                         If Len(j) > 1 Then .Font.Size = 18
    
56.                         .Font.NameFarEast = "黑体"
    
57.                         With .ParagraphFormat
    
58.                             .SpaceBefore = 24
    
59.                             .SpaceAfter = 24
    
60.                         End With
    
61.                         If .Text Like "*[。：；，、！？…—.:;,!?]?" Then .Characters.Last.Previous.Delete
    
62.                         If .Text Like "*　???" Then .Characters.Last.Previous.InsertBefore Text:=Chr(-24159)
    
63.                         .MoveEnd 1, -(Len(.Text) - (InStr(.Text, j) + Len(j) - 1))
    
64.                     End If
    
65.                     .MoveStart 1, 1
    
66.                     .MoveEnd 1, -Len(j)
    
67.                     i = i + 1
    
68.                     .Text = i
    
69.                     If n = 2 Then
    
70.                         .Delete
    
71.                         .Fields.Add Range:=r, Text:="= " & i & " \* CHINESENUM3"
    
72.                         .Paragraphs(1).Range.Fields.Unlink
    
73.                     End If
    
74.                     .Expand 4
    
75.                     r.SetRange Start:=r.End - 1, End:=s.End
    
76.                 Else
    
77.                     .Tables(1).Range.Next.Select
    
78.                     With Selection
    
79.                         If .End > s.End Then End
    
80.                         If Asc(.Text) <> 13 Then .InsertParagraphBefore
    
81.                         .Characters(1).Font.Size = 4
    
82.                         r.SetRange Start:=.Start, End:=s.End
    
83.                     End With
    
84.                 End If
    
85.             End With
    
86.         Loop
    
87.     End With
    
88.     If x = 0 Then MsgBox "选定区域未找到<第一" & j & ">！！！", 0 + 16
    
89. End Sub

复制代码