word文档单词自动加音标的宏代码

来源：高中英语教学交流
发布时间：2012-11-04 10:41:00
查看次数：

内容提要：有时候要在单词中加音标，现在有了这个代码就方便很多了。此代码会在最新版的ZSHUNJ工具箱增加，敬请期待。

word文档单词单词自动加音标的宏代码（注意****为修改的地方）

Sub GetPhonetic()

'必须有音标字体安装Kingsoft Phonetic Plain

'写在前面:您运行此程序前必须引用MSForms

'即VBE/工具/引用:Microsoft Forms 2.0 Object Library (C:\WINNT\system32\FM20.DLL)

'打开金山词霸,并使用显示在任务栏中,不是最小化系统托盘(启动栏)中!!(金山词霸/主菜单/

'设置/界面方案/其它/其它选项:任务栏图标,去勾)并关闭屏幕取词功能!

'将每个单词为一个段落,注意,本程序未加入单词拼写检查,可在WORD中拼写和语法检查中设置

Dim EwTxt As String, MyData As DataObject, CopyTxt As String, MyRange As Range

Dim Mystring() As String, aString As String, i As Paragraph, StartWrite As Long

On Error Resume Next

If Tasks.Exists("****此处填写金山词霸任务栏中显示的文字，如“金山词霸2007（暂停取词）”****") = False Then Exit Sub '如果未在任务栏中则关闭程序

Tasks("****此处填写金山词霸任务栏中显示的文字，如“金山词霸2007（暂停取词）”****").WindowState = wdWindowStateNormal '正常窗口

Set MyData = New DataObject '引用DataObject

Application.ScreenUpdating = False '关闭屏幕更新

With ActiveDocument

For Each i In .Paragraphs '在段落中循环

If Len(i.Range) = 1 Then GoTo GN '如果为空白段落则继续下一次

EwTxt = i.Range.Text '返回文本(单词)

StartWrite = i.Range.End - 1 '取得段落标记前的位置

Set MyRange = .Range(StartWrite, StartWrite) '取得段落标记前的插入点区域

Tasks("****此处填写金山词霸任务栏中显示的文字，如“金山词霸2007（暂停取词）”****").Activate '激活金山词霸应用程序，此处填写金山词霸任务栏的内容，如金山词霸2007

SendKeys EwTxt, True '发送单词

SendKeys "{TAB 2}", True '移动二次TAB

SendKeys "^c", True '复制

MyData.GetFromClipboard '从剪贴板复制数据到 DataObject

CopyTxt = MyData.GetText(1) '获得无格式文本

Mystring = VBA.Split(CopyTxt, vbCrLf) '返回一个数组

aString = Mystring(1) '取得数组中的第二个值,也就是音标

MyRange.InsertAfter "　" & aString '在插入点处插入音标

'设置该区域的音标字体

.Range(StartWrite + 2, i.Range.End - 2).Font.Name = "Kingsoft Phonetic Plain"

GN: Next

Application.ScreenUpdating = True '恢复屏幕更新工作

Tasks(VBA.Replace(.Name, ".doc", "")).Activate '激活WORD文档

'提示

MsgBox "自动音标标注工作已经结束!", vbInformation + vbOKOnly, "Microsoft Word"

End With

End Sub