word录制宏为整篇word文档加拼音标注的方法
打印一篇童话,突然想到如果为童话加上标音会更适合小孩阅读,就试图为整篇文档加拼音标注,但结果令我失望,微软的word加拼音有字数限制,每次只能为几十个字加拼音标注,如果以这种方式为一篇几千字的童话加拼音,工作量将会令人无法忍受。为此,我决定为word加一个简单的宏命令,令这个工作简单化。
由于对word宏命令不太熟悉,我将个任务分解为三部分,第一,了解光标的移动指令;第二,了解加拼音的命令;第三,对排版进行一些美化调整。
第一点并不复杂,简单录制一个宏,移动一下光标,就很清楚地看到移动的指令了。
Selection.MoveRightunit:=wdCharacter,Count:=1,Extend:=wdExtend
接下来,我在msdn简单浏览了一下selection对象以及一些move前缀的方法,初步了解了一些移动的指令。
第二点,我右键点了下菜单,在自定义菜单中找了“拼音标准”对应的命令FormatPhoneticGuide,以此为关键字进行搜索,很快就得到了在宏中使用的简单调用方法,但这个方法我觉得不科学,如果有软件处理响应时间跟不上,很容易就会崩溃,但没找到更好的方法:
SendKeys"{enter}",2‘模拟键盘输入,2是等待时间,因为加拼音标注的对话框调用在后面,为了正确向它发出回车键信息,要等几秒,事实上这个值越大越安全,但等待时间太长会影响程序的运行效率,这个方法我认为不太好,但没有找到FormatPhoneticGuide的其它信息,也就将就使用这个笨方法了!Application.RunMacroName:="FormatPhoneticGuide"
第三点,为了让加了拼音后的文字容易阅读,我决定每个字之间都加上一个空格,否则的话,拼音全挤在一起,会令小孩在拼读时迷惑,这相当简单,录制一个宏,就按一下键盘箭头右移动,然后打个空格就好了,在程序中可以将这个动作循环一下。
Addpinyin的宏很快就写好,我一句句单步了一下,没有什么意外,效果还不错,直接上结果图。喜欢的朋友可以也可以看看完整的宏代码。
复制代码代码如下:
Sub AddPinYin()
'Author:MissileCat Date:20140410 version:1.0.0
' Addpinyin 宏
'为一篇完整的word文字加上标音标注</p>
<p> Dim tintTreatingCount As Integer
Dim tstrCharA As String
Dim tlngCurPos As Long
Dim tintA As Integer</p>
<p>
Selection.WholeStory
tstrText = Selection.Text
tintTextLength = Selection.Characters.Count
tintlinestart = 1</p>
<p> tintTreatingCount = 0</p>
<p> Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1</p>
<p> Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1
For tintloopx = 1 To tintTextLength
tlngCurPos = Selection.MoveRight(unit:=wdCharacter, Count:=1, Extend:=wdExtend)
tstrCharA = Right(Selection.Text, 1)
If AscW(tstrCharA) < 255 And AscW(tstrCharA) > -255 Then
If tintTreatingCount > 0 Then
tintA = Len(Selection.Text)
SendKeys "{enter}", 2
Application.Run MacroName:="FormatPhoneticGuide"
Selection.MoveRight unit:=wdCharacter, Count:=tintA</p>
<p> tintTreatingCount = 0</p>
<p> End If
Else
tintTreatingCount = tintTreatingCount + 1
End If
Next</p>
<p> '为每个字都加上空格
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1</p>
<p> 'Selection.HomeKey unit:=wdStory</p>
<p> For tintloopx = 1 To tintTextLength
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Next
MsgBox "任务成功完成"
' .Range.PhoneticGuide Text:="lǐ", Alignment:= _
' wdPhoneticGuideAlignmentOneTwoOne, Raise:=15, FontSize:=8, FontName _
' :="宋体"
End Sub