第一章（宏）集成版：第1章/条/节/课/题/部分/自然段

413191246se

* 特殊感谢：本论坛高人 loquat 朋友，跟他学会了 InStr()函数用法，此宏得力于此！也因此未使用 Selection 对象，而全程使用 Range 对象，速度比较快。
* 代码中含有红色/蓝色的代码，使用的朋友可以自行注释掉或删除之。极限：第九百九十九条/第9999条。
* 代码后面附上 demo 文本，方便各位朋友测试本宏。
*《第一章》宏功能：可设置以《第一章/第1章/第一条/第1条/节/课/题/部分/自然段……》等集成量词引领的段落，设置格式有两种：一种是《居中/副标题》格式，另一种是《普通加粗》格式。
*《第一章》宏代码：

1. Sub 第一章()
   
2.     Dim i As Paragraph, j As String, k As Long, s As Long
   
3.     j = InputBox("请输入[章/条/节/课/题/部分/自然段]等量词！", "第一章/第1章/条/节/课/题/部分/自然段", "章")
   
4.     If j = "" Then Exit Sub
   
5.     If MsgBox("是：<居中/副标题>格式    否：<普通加粗>格式", vbYesNo + vbExclamation, "请选择设置[第一" & j & "]的格式！") = vbYes Then k = 1 Else k = 2
   
6.     For Each i In ActiveDocument.Paragraphs
   
7.         If i.Range Like "第[一二三四五六七八九十]" & j & "*" Or i.Range Like "第[一二三四五六七八九十][一二三四五六七八九十百]" & j & "*" Or i.Range Like "第[二三四五六七八九]十[一二三四五六七八九]" & j & "*" Or i.Range Like "第[一二三四五六七八九]百[一二三四五六七八九零][一二三四五六七八九十]" & j & "*" Or i.Range Like "第[一二三四五六七八九]百[一二三四五六七八九]十[一二三四五六七八九]" & j & "*" Or i.Range Like "第#" & j & "*" Or i.Range Like "第##" & j & "*" Or i.Range Like "第###" & j & "*" Or i.Range Like "第####" & j & "*" Then
   
8.             i.Range.Find.Execute findtext:="　", replacewith:="", Replace:=wdReplaceAll
   
9.             i.Range.Find.Execute findtext:="^w", replacewith:="", Replace:=wdReplaceAll
   
10.             s = InStr(i.Range, j)
    
11.             If Len(j) = 1 Then
    
12.                 i.Range.Characters(s).InsertAfter Text:="　"
    
13.             Else
    
14.                 i.Range.Characters(s + Len(j) - 1).InsertAfter Text:="　"
    
15.             End If
    
16.             If k = 1 Then
    
17.                 If Len(j) = 1 Then
    
18.                     If Len(i.Range) - s - 2 = 2 Then i.Range.Characters(s + 2).InsertAfter Text:="　"
    
19.                 Else
    
20.                     If Len(i.Range) - s - Len(j) - 1 = 2 Then i.Range.Characters(s + Len(j) + 1).InsertAfter Text:="　"
    
21.                 End If
    
22.                 With i.Range
    
23.                     .Style = wdStyleSubtitle
    
24.                     With .Font
    
25.                         .Name = "黑体"
    
26.                         .Name = "Arial"
    
27.                         .Color = wdColorRed '红色
    
28.                     End With
    
29.                     With .ParagraphFormat
    
30.                         .SpaceBefore = 24
    
31.                         .SpaceAfter = 18
    
32.                         .AutoAdjustRightIndent = False
    
33.                         .DisableLineHeightGrid = True
    
34.                     End With
    
35.                 End With
    
36.             Else
    
37.                 If Len(j) <> 1 Then s = s + Len(j) - 1
    
38.                 With ActiveDocument.Range(Start:=i.Range.Start, End:=i.Range.Characters(s).End).Font
    
39.                     .Name = "黑体"
    
40.                     .Name = "Times New Roman"
    
41.                     .Bold = True
    
42.                     .Color = wdColorBlue '蓝色
    
43.                 End With
    
44.             End If
    
45.         End If
    
46.     Next
    
47.     MsgBox "处理完毕！", vbOKOnly + vbExclamation, "第一章/第1章/条/节/课/题/部分/自然段"
    
48. End Sub

复制代码

*****************测试 demo 文本：**********
第一，一建立并运用学生学业成绩动态发展模型。测试结束。
第一题 命题要根据教学计划要求。突出重点。
第1节 改革开放。素质教育。
第一条         　条件章要根据教学计划要求。突出重点。
第一条条件要根据教学计划要求。突出重点。******
第二节  与时俱进。解放思想。
一条条信件。解放思想。
第二，一建立成绩动态发展模型。结束。
第1条　 条件确保学业测试的命题质量。着重考察学生能力。
第21条         　条件合理安排学业测试的频次。不能以考代练切实减轻学生过重课业负担。要正确认识测试的功能。确保学业测试的命题质量。
第一章 总 则
第二十二条  条件认真做好阅卷讲评工作。测试后要及时、认真阅卷。
第1章         　章 程
第三章　计算机
第10章 章程规定
第十章 章程规定
第99章 章程明确规定。
第五十条  条件要正确认识测试章功能。严格控制各类教学测试频次。
第100章 章程要求
第99条  条件确保学业测试的命题质量。着重考察学生能力。
第101章 章程细则
第十一章 章程要求。
第三十章 章程里是这样说的
第240章 章程原则。
第999章 章程原因
第1000章 章程待遇
六、教学反思
第九十九章 章程限制了义务和权利。
第一百章 考   查
第一百零一章 章程明确规定。中国中国。
第一百一十章 分配
第九百九十九章 章程写明了。
第23条  条件促进学生自悟。无论是平时测试还是其中。
第101条  条件要正确认识平时教学测试的功能。各类教学测试频次。
第9999条 条件采用标准分等统计技术。建立并运用学生学业模型。
第99999条  条件采用标准分等章统计技术。建立运用学生学业模型。
第九百九十九条  条件出试卷分析报告。要根据试卷分析结果。
第99条条件。******

三羧酸

非常不错，感谢分享