标题2345自动设置（宏）——极速！

413191246se

前几天，观看 守柔版主 的代码集，关于 Instr 函数的用法，觉得繁琐，我尝试再三，结合最近 ming0018 老师关于不用 Selection/Select 对象/方法，避免激活对象的提速编程要求，最终成功！欢迎批评指正（请注意：此宏怕空行！）。

1. Sub Title2345Style()
   
2. '避免激活对象！/提速成功！/完成时间=.046秒！(极速)/2018-12-31/定稿！
   
3.     Dim i As Paragraph, s$, n&
   
4.     s = "一二三四五六七八九十1234567890百零〇○"
   
5.     For Each i In ActiveDocument.Paragraphs
   
6.         With i.Range
   
7.             If Not .Information(12) Then
   
8.                 n = 1
   
9.                 If .Text Like "（*" Then n = 2
   
10.                 Do While InStr(s, .Characters(n)) > 0
    
11.                     n = n + 1
    
12.                     If .Characters(n).Text = "、" Then .Style = wdStyleHeading2: Exit Do
    
13.                     If .Characters(n).Text = "）" And Not .Text Like "（#*" Then .Style = wdStyleHeading3: Exit Do
    
14.                     If .Characters(n).Text = "．" Then .Style = wdStyleHeading4: Exit Do
    
15.                     If .Characters(n).Text = "）" And .Text Like "（#*" Then .Style = wdStyleHeading5: Exit Do
    
16.                 Loop
    
17.             End If
    
18.         End With
    
19.     Next
    
20. End Sub

复制代码

413191246se

补：1楼代码运行还有个前提，就是标题4如果是顿号或小数点（、.），必须全部替换为齐线墨点（．）才行。

jiangxiaoyun

这区比较冷.....

413191246se

jiangxiaoyun（蒋/江/姜 晓/小/笑 云）你好！我注意到你是最近才来本板块的，但水平是很高的！佩服！以前经常在哪个板块？我一直在本板块，从 2011年7月加入本论坛本板块，一直在做《通用模板宏》，现在水平的确比过去长了一大截，但还是很低的。——我的代码有什么可以修正之处，请批评指正指教，谢谢！

sandorn

不知道楼主的代码是什么作用？
是自动设置标题吗？
能否帮忙优化一下下面的代码？或者没有必要优化了？

1. Sub 设置公文格式()
   
2.     '将全文逐段设置格式为"正文GB"，并修改章节条的格式
   
3.     Application.ScreenUpdating = False
   
4.     Dim t: t = Timer
   
5.     If ActiveDocument.Fields.Count <> 0 Then Call FieUnlink '去除域代码
   
6.     Dim regEx As New RegExp '构建正则
   
7.     regEx.IgnoreCase = True: regEx.Global = False: regEx.MultiLine = False
   
8.     Dim idx
   
9.     For Each idx In ActiveDocument.Paragraphs '按段落循环
   
10.         If Not idx.Range.Information(wdWithInTable) Then '判断非表格内
    
11.             idx.Range.Style = ActiveDocument.Styles("公文正文") '样式名称
    
12.             Dim patt, mStyle, bSp, bArticle
    
13.             patt = Array("( :^[　 ]*)(第[零〇一二三四五六七八九十百\d]+条)( :[　 ]*)([^　 ][^\r]*)", _
    
14.                 "( :^[　 ]*)(第[零〇一二三四五六七八九十百\d]+章)( :[　 ]*)([^　 ][^\r]*)", _
    
15.                 "( :^[　 ]*)(第[零〇一二三四五六七八九十百\d]+节)( :[　 ]*)([^　 ][^\r]*)")
    
16.             mStyle = Array("公文正文", "公文1级", "公文2级")
    
17.             bSp = Array(True, True, True)
    
18.             bArticle = Array(True, False, False)
    
19.             Dim i%
    
20.             For i = 0 To UBound(patt)
    
21.                 regEx.Pattern = patt(i)
    
22.                 Dim Index$, Subject$, m%, n%, oRang As Range
    
23.                 If regEx.Test(idx.Range) Then
    
24.                     Index = regEx.Execute(idx.Range)(0).SubMatches(0) '序号
    
25.                     Subject = IIf(bSp(i), Replace(Replace(regEx.Execute(idx.Range)(0).SubMatches(1), "　", ""), " ", ""), regEx.Execute(idx.Range)(0).SubMatches(1)) '标题是否去掉空格
    
26.                     m = regEx.Execute(idx.Range)(0).FirstIndex: n = regEx.Execute(idx.Range)(0).length
    
27.                     Set oRang = ActiveDocument.Range(idx.Range.Start + m, idx.Range.Start + m + n)
    
28.                     oRang.Text = Index & "　" & Subject
    
29.                     oRang.Style = ActiveDocument.Styles(mStyle(i)) '样式名称
    
30.                     If bArticle(i) Then
    
31.                         Set oRang = ActiveDocument.Range(oRang.Start, oRang.Start + Len(Index))
    
32.                         oRang.Font.Bold = True
    
33.                     End If
    
34.                 End If
    
35.                 Index = "": Subject = "": m = 0: n = 0: Set oRang = Nothing
    
36.             Next i
    
37.         End If
    
38.     Next
    
39.     Application.ScreenUpdating = True
    
40.     ActiveDocument.Activate
    
41. End Sub

复制代码

413191246se

sandorn 朋友，你好！
——我认真看了你的代码，但发现有正则表达式，这个我理解不深，已经放弃；因为去年学了几天正则，感觉问题并不简单，当然是我没有领会正则实质。正则问题，应该讨教本坛正则专家杜老师（duquancai 杜全才），他是本坛大神！
——代码中也有数组，也很好，这个我也是半会不会、一知半解的；又牵涉到《章/节/条》的问题，这个我不好说了。公文里面有章/节/条需要设置吗？
——最后，我强烈建议：如果你使用 Word2003 版本（即使是 2007 或更高版本，也可以参考其中的代码），可以试用我的《Word2003VBA通用模板宏（2019元旦版）》帖子里面提供的代码（附件）。感觉自己还是一个比较讲究的人，公文格式均按2012年国家公文标准设置排版，起码正文和公文标题四个层次都是合格的，但页面设置是默认A4纸张，行距是1.5倍，不多说了，公文标准其实也不标准，我的看法是尽量符合公文标准即可，也不必强求绝对与公文标准一致。我有一个《第一章》宏可以自动设置章节条。但我认为常用公文里面是没有章节条的，很少用到。其实我 Word 水平挺低的，很多高深知识并不会，如：题注、脚注、尾注、修订、审阅等知识点均不会；域稍微会一点，现在就指着 VBA 自动排版了；像多级编号，因为我用不到，所以，也根本没作为标题来编程。平时就是一些小文档，我的宏也是提供了初步、简易的公文一键快速自动排版。如果有兴趣，欢迎和我在本坛进行公文自动排版方面的交流。

tanshuizhu

413191246se 发表于 2019-1-9 00:04
sandorn 朋友，你好！
——我认真看了你的代码，但发现有正则表达式，这个我理解不深，已经放弃；因为去年 ...

求助：将word表格数据链接到excel后，excel数据变更后如何让word表格格式不变更。
如附件，word中的表格格式要求保持（如行高、边框、字体、居中等），想变更excel数据然后word数据刷新但格式保持不变，不知如何实现。

xiaoyouxi01

413191246se 发表于 2019-1-4 00:48
补：1楼代码运行还有个前提，就是标题4如果是顿号或小数点（、.），必须全部替换为齐线墨点（．）才行。

请问下，这个多层次标题里的1.  2.  3.  这个要用全角小数点？
12版公文国标里也没提这个，哪里有依据吗？

413191246se

楼上朋友好！这个全角小数点，它叫：齐线墨点，怎么打出来呢？在中文输入法状态条上，打开软键盘菜单，找到《标点符号》一项，在回车键左边的那个键就是齐线墨点了！过去我也不知道，也是前几年在网上看公文标准时才知道的。打出它很费劲，但只要是用了我的代码来排版，其实在录入时不必费力打出齐线墨点来，只须在数字后面键入顿号（如：1、）或数字后面键入小数点（如1.），程序会自动将顿号/小数点转换为齐线墨点的。

tanshuizhu

求助：将word表格数据链接到excel后，excel数据变更后如何让word表格格式不变更。 如附件，word中的表格格式要求保持（如行高、边框、字体、居中等），想变更excel数据然后word数据刷新但格式保持不变，不知如何实现。