ABCD选项对齐工具代码


来源:高中英语教学交流网
发布时间:2020-06-01 16:20:00
查看次数:

内容提要:ABCD选项对齐,主要是针对于完形填空的选项排版。一键操作,排版后选项整齐美观,当然选择题部分(任何科目)也是可以使用。

很久以前(第一个版本是在2011年),制作过一个ZSHUNJ工具箱。第三个版本(2012年)后就没有再更新了。

点击这里查看历史版本


我一直都在使用,而且我个人使用的版本偶尔还会增加一些内容,不过使用率最高的依然是ABCD选项对齐。

ABCD选项对齐,主要是针对于完形填空的选项排版。一键操作,排版后选项整齐美观,当然选择题部分(任何科目)也是可以使用。

随着office版本的升级(最初是2003,现在2016都有了),一些机制改变了,使用起来有些不方便。

有留言询问何时再更新,考虑之后,觉得使用一种容易操作的方式使得这个对齐功能能够使用就行。

操作步骤:点击这里查看图示版


1、以word 2016 版本为例,开发工具-宏-宏名-创建

2、复制文末代码到下图中到位置,保存。

3、为达到更好效果,建议页面设置为左右上下边距为2。

4、使用时,选定ABCD,ALT+F8 调出如下界面,点击运行就行了。5ABCD对齐之后再统一设置字体等排版操作。

由于office版本不同或电脑配置不同,运行时可能会出现一些错误提示。基本上按确定就可以。


Sub ABCD选项对齐()

Dim myFind() As Variant, myReplace As String

Dim aArray As Variant, mySet As String, n As Integer, M As Integer

Dim myRange As Range, myBk As Bookmark

myFind = Array("A", "B", "C", "D", "E", "F", "G", "A", "B", "C", "D")

If Selection.Type = wdSelectionIP Then Exit Sub

Application.ScreenUpdating = False

Set myBk = ActiveDocument.Bookmarks.Add(Name:="Temp", Range:=Selection.Range)

With myBk.Range

With .ParagraphFormat

.CharacterUnitLeftIndent = 0

.CharacterUnitRightIndent = 0

.CharacterUnitFirstLineIndent = 0

.LeftIndent = CentimetersToPoints(0)

.RightIndent = CentimetersToPoints(0)

.FirstLineIndent = CentimetersToPoints(0)

.TabStops.ClearAll

.LineSpacingRule = wdLineSpaceExactly

.LineSpacing = 20

End With

With .Font

.NameFarEast = "宋体"

.NameAscii = "Times New Roman"

.NameOther = "Times New Roman"

.Name = "Times New Roman"

.Size = 15

End With


With .Find

.ClearFormatting

.Replacement.ClearFormatting

.Wrap = wdFindStop

.MatchWildcards = False

.Execute findtext:="^t", replacewith:="", Replace:=wdReplaceAll

End With


With .Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = "([!a-zA-Z])[  " & ChrW(160) & "]{1,}"

.MatchWildcards = True

.Wrap = wdFindStop

.Font.Underline = False

.Execute replacewith:="\1", Replace:=wdReplaceAll

End With


With .Find

.ClearFormatting

.Format = True

.Replacement.ClearFormatting

.Replacement.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly

.Replacement.ParagraphFormat.LineSpacing = 20

.MatchWildcards = True

.Wrap = wdFindStop

.Text = "[一-龥]{5,}"

.Execute replacewith:="", Replace:=wdReplaceAll

End With


With .Find

.ClearFormatting

With .Replacement

.ClearFormatting

.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(1.11)

.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(5.11)

.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(10.11)

.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(15.11)

End With

.Text = "[A-G A-D][.、.]"

.Replacement.Text = "^t^&"

.Wrap = wdFindStop

.Format = True

.MatchWildcards = True

.Execute Replace:=wdReplaceAll

End With


Set myRange = myBk.Range

NR1:         With myRange.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = "A[.、.][!^13]@B[.、.][!^13]@^13^tC[.、.]*D[.、.]*^13"

.MatchWildcards = True

Do While .Execute

With myRange

.ParagraphFormat.TabStops.ClearAll

.ParagraphFormat.TabStops.Add CentimetersToPoints(1.11)

.ParagraphFormat.TabStops.Add CentimetersToPoints(10.11)

.SetRange .End, myBk.Range.End

GoTo NR1

End With

Loop

End With



Set myRange = myBk.Range

NR2:         With myRange.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = "A[.、.][!^13]@B[.、.][!^13]@^13^tC[.、.]*D[.、.]*^13"

.MatchWildcards = True

Do While .Execute

With myRange

.ParagraphFormat.TabStops.ClearAll

.ParagraphFormat.TabStops.Add CentimetersToPoints(1.11)

.ParagraphFormat.TabStops.Add CentimetersToPoints(10.11)

.SetRange .End, myBk.Range.End

GoTo NR2

End With

Loop

End With



With .Find

.ClearFormatting

.Replacement.ClearFormatting

.MatchWildcards = True

.Execute findtext:="[\((][\))]", replacewith:="(^32^32^32) ", Replace:=wdReplaceAll

End With

With .ParagraphFormat

.LineUnitBefore = 0

.LineUnitAfter = 0

.SpaceBefore = 0

.SpaceAfter = 0

.SpaceBeforeAuto = False

.SpaceAfterAuto = False

End With


mySet = VBA.InputBox(Prompt:="请选择选项样式,1为'A.',2为'A.',3为 'A、',单击取消退出替换!", Title:="选项样式设置", Default:=1)

Select Case mySet

Case ""

myBk.Delete

Exit Sub

Case 1

myReplace = ". "

n = 64

Case 2

myReplace = "."

n = 64

Case 3

myReplace = "、"

n = 64

Case Else

myReplace = aArray

If aArray = "[A-G]." Then

n = -23616

Else

n = 64

End If

End Select

For Each aArray In myFind

M = M + 1

If M = 8 Then M = 1

With .Find

.ClearFormatting

.Replacement.ClearFormatting

.MatchWildcards = True

.Wrap = wdFindStop

.Execute findtext:=aArray & "[.、.]", replacewith:=VBA.Chr(M + n) & myReplace, Replace:=wdReplaceAll

End With

Next

myBk.Delete

End With

Application.ScreenUpdating = True

End Sub


相关文章
·模仿朗读《四季中国》Seasons of China 小暑07-08
·[听说备考] 2023年广东一模听说考试录制版03-02
·2024年1月17日 周测二讲评01-17
·《将来的你一定会感谢现在拼命的自己》摘录06-14
·温磬提示:雷雨季节注意电脑防雷 04-07
·[语法填空] 2019年人教版 B3U3 Reading and05-09
·各题得分打印辅助模板09-28
·2021年高考英语(新高考I卷)阅读理解D篇译文及词汇注释06-18
·What? 这是ChatGPT写的高中英语应用文02-15
·作了一回主编04-21
最新文章
阅读排行