选项对齐（宏）最新更新 2022-10-01

tangqingfu

413191246se 发表于 2022-10-4 19:40
* sylun 兄：我用表格填充版心再减去两个 0.19 厘米（想起过去《表格处理》宏里面的 .padding=0.19）得到当 ...

能否请413191246se重新分享下处理 2、3、4、5 个选项的宏代码，忘记保存了
英文试卷可能涉及选项不一样情况，有些选择题是3个选项，有些是4个选项

sylun

tangqingfu 发表于 2022-10-4 21:34
sylun兄，用您的代码测试附件的文档，好像效果不好，是不是我操作不对

tang兄的新文档与之前提供的文档有两点不同：一是两节的页边距设置不同，导致wid值出错，前面我已表示忽略右缩进与节格式页边距差异，要考虑就得用Range对象的Information属性获取aRange对象所在的节编号，再获取该节的页边距信息，就新文档本例可将第6行代码改为With ActiveDocument.Sections(1).PageSetup。
二是文档中有的选项中隐藏了不可见的1号字符，不知从何而来的，十分奇怪。要先清除它，可将第67行代码改为：For Each Match In .Execute(Replace(aRange.Text, Chr(1), ""))

413191246se

tang 兄：还好，最近我保存了一些历史版本。在 9月30日 的版本中找到了 2345 个选项对齐的宏。
sylun 兄：像示例文档中有两个不可见字符，我觉得不清除也可以，无非就是多占几行。
今晚，我又折腾了一下《公文排版、普通排版、条文排版》三个宏，前两个默认段后一行，后者段后空段。

1. Sub OptionAlign()
   
2. '选项对齐
   
3.     Dim t As Table, i As Paragraph, TableWidth!, oTab!, Tab1!, Tab2!, Tab3!, Tab4!, OptionNum&
   
4. 
   
5.     With ActiveDocument
   
6.         .Tables.Add .Range(0, 0), 1, 1
   
7.         TableWidth = Round(.Tables(1).Cell(1, 1).Width / 28.35, 2)
   
8.         .Tables(1).Delete
   
9. 
   
10.         .Content.Find.Execute "^l", , , 0, , , , , , "^p", 2
    
11. 
    
12.         For Each t In .Tables
    
13.             With t.Range.Rows
    
14.                 .WrapAroundText = False
    
15.                 .Alignment = wdAlignRowCenter
    
16.             End With
    
17.         Next
    
18. 
    
19.         With .Content.Find
    
20.             .Execute "(^13)([ 　^s^t]{1,})", , , 1, , , , , , "\1", 2
    
21.             .Execute "([ 　^s^t]{1,})(^13)", , , 1, , , , , , "\2", 2
    
22.             .Execute "([A-E])[.、]", , , 1, , , , , , "\1．", 2
    
23.             .Execute "([ 　^s^t^13]{1,})([B-E]．)", , , 1, , , , , , "\2", 2
    
24.             .Execute "(^13)([0-9]{1,})[.、]", , , 1, , , , , , "\1\2．", 2
    
25.             .Execute "([B-E]．)", , , 1, , , , , , "^t\1", 2
    
26.         End With
    
27. 
    
28.         For Each i In .Paragraphs
    
29.             With i.Range
    
30.                 If Not .Information(12) Then
    
31.                     If .Text Like "A．*" Then
    
32.                         With .Font
    
33.                             If .ColorIndex = wdRed Then .ColorIndex = wdBlue Else .ColorIndex = wdRed
    
34.                             .Bold = wdToggle
    
35.                         End With
    
36. 
    
37.                         If .Text Like "A．*B．*C．*D．*E．*" Then
    
38.                             OptionNum = 5
    
39.                             GoSub op
    
40.                             With .ParagraphFormat.TabStops
    
41.                                 .ClearAll
    
42.                                 .Add Position:=CentimetersToPoints(Tab1)
    
43.                                 .Add Position:=CentimetersToPoints(Tab2)
    
44.                                 .Add Position:=CentimetersToPoints(Tab3)
    
45.                                 .Add Position:=CentimetersToPoints(Tab4)
    
46.                             End With
    
47. 
    
48.                             'cut
    
49.                             If .ComputeStatistics(1) = 2 Then
    
50.                                 .Find.Execute "^t([CE]．)", , , 1, , , , , , "^p\1", 2
    
51.                             End If
    
52. 
    
53.                         ElseIf .Text Like "A．*B．*C．*D．*" Then
    
54.                             OptionNum = 4
    
55.                             GoSub op
    
56.                             With .ParagraphFormat.TabStops
    
57.                                 .ClearAll
    
58.                                 .Add Position:=CentimetersToPoints(Tab1)
    
59.                                 .Add Position:=CentimetersToPoints(Tab2)
    
60.                                 .Add Position:=CentimetersToPoints(Tab3)
    
61.                             End With
    
62. 
    
63. '                            'cut
    
64.                             If .ComputeStatistics(1) = 2 Or .ComputeStatistics(1) = 3 Then
    
65.                                 .Find.Execute "^t(C．)", , , 1, , , , , , "^p\1", 2
    
66.                             ElseIf .ComputeStatistics(1) = 4 Then
    
67.                                 .Find.Execute "^t([BD]．)", , , 1, , , , , , "^p\1", 2
    
68.                             End If
    
69.                             'cuts
    
70.                             If .ComputeStatistics(1) = 2 Then
    
71.                                 With .ParagraphFormat.TabStops
    
72.                                     .ClearAll
    
73.                                     .Add Position:=CentimetersToPoints(Tab2)
    
74.                                 End With
    
75.                             ElseIf .ComputeStatistics(1) = 4 Then
    
76.                                 .Find.Execute "^t([B-D]．)", , , 1, , , , , , "^p\1", 2
    
77.                             End If
    
78. 
    
79.                         ElseIf .Text Like "A．*B．*C．*" Then
    
80.                             OptionNum = 3
    
81.                             GoSub op
    
82.                             With .ParagraphFormat.TabStops
    
83.                                 .ClearAll
    
84.                                 .Add Position:=CentimetersToPoints(Tab1)
    
85.                                 .Add Position:=CentimetersToPoints(Tab2)
    
86.                             End With
    
87. 
    
88.                             'cut
    
89.                             If .ComputeStatistics(1) = 2 Then
    
90.                                 .Find.Execute "^t([BC]．)", , , 1, , , , , , "^p\1", 2
    
91.                             End If
    
92. 
    
93.                         ElseIf .Text Like "A．*B．*" Then
    
94.                             OptionNum = 2
    
95.                             GoSub op
    
96.                             With .ParagraphFormat.TabStops
    
97.                                 .ClearAll
    
98.                                 .Add Position:=CentimetersToPoints(Tab1)
    
99.                             End With
    
100.                         End If
     
101. 
     
102.                         With .ParagraphFormat
     
103.                             .CharacterUnitFirstLineIndent = 0
     
104.                             .FirstLineIndent = CentimetersToPoints(0)
     
105.                             .CharacterUnitLeftIndent = 0
     
106.                             .LeftIndent = CentimetersToPoints(0)
     
107.                             .CharacterUnitRightIndent = 0
     
108.                             .RightIndent = CentimetersToPoints(0)
     
109.                             .CharacterUnitFirstLineIndent = 2
     
110.                         End With
     
111.                     End If
     
112.                 End If
     
113.             End With
     
114.         Next
     
115.     End With
     
116.     Exit Sub
     
117. 
     
118. op:
     
119.     If OptionNum = 4 Then
     
120.         oTab = (Int((TableWidth - 2 * 0.19) * 2.7 + 0.5) - 2) / 4
     
121.         Tab1 = Round((2 + 1 * oTab) / 2.7, 2)
     
122.         Tab2 = Round((2 + 2 * oTab) / 2.7, 2)
     
123.         Tab3 = Round((2 + 3 * oTab) / 2.7, 2)
     
124. 
     
125.     ElseIf OptionNum = 3 Then
     
126.         oTab = (Int((TableWidth - 2 * 0.19) * 2.7 + 0.5) - 2) / 3
     
127.         Tab1 = Round((2 + 1 * oTab) / 2.7, 2)
     
128.         Tab2 = Round((2 + 2 * oTab) / 2.7, 2)
     
129. 
     
130.     ElseIf OptionNum = 2 Then
     
131.         oTab = (Int((TableWidth - 2 * 0.19) * 2.7 + 0.5) - 2) / 2
     
132.         Tab1 = Round((2 + 1 * oTab) / 2.7, 2)
     
133. 
     
134.     ElseIf OptionNum = 5 Then
     
135.         oTab = (Int((TableWidth - 2 * 0.19) * 2.7 + 0.5) - 2) / 5
     
136.         Tab1 = Round((2 + 1 * oTab) / 2.7, 2)
     
137.         Tab2 = Round((2 + 2 * oTab) / 2.7, 2)
     
138.         Tab3 = Round((2 + 3 * oTab) / 2.7, 2)
     
139.         Tab4 = Round((2 + 4 * oTab) / 2.7, 2)
     
140.     End If
     
141.     Return
     
142.     'cm=char/2.7
     
143. End Sub

复制代码

wangweixiang11

测试了下，最后一个选项如果过长的话不能将每个选项单独成行

文字控

你好，如果有图的题目，选项都弄成一个选项一段，代码应该怎么修改呢？

413191246se

楼上朋友，你好！替换的话手动也可以，但有时测试时 Word 会崩溃；代码的好处是不易崩溃。
请试用下面的代码：

1. Sub a0001_answer_replace_ABCD()
   
2.     ActiveDocument.Content.Find.Execute "([!^13])([BCD][.．、])", , , 1, , , , , , "\1^p\2", 2
   
3. End Sub

复制代码