[分享]WORD与金山词霸-自动标注音标的小程序

守柔 · 发表于 2005-2-25 08:10

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-2-25 08:09:09
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub GetPhonetic()
'写在前面:您运行此程序前必须引用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("金山词霸") = False Then Exit Sub    '如果未在任务栏中则关闭程序
    Tasks("金山词霸").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("金山词霸").Activate    '激活金山词霸应用程序
            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
'----------------------

2jw0ZWSo.zip (12.42 KB, 下载次数: 948)

[此贴子已经被konggs于2006-8-17 21:06:27编辑过]

办公之星 · 发表于 2005-2-25 08:52

坚决支持守柔同志将革命进行到底。

水平太高，偶等已无力跟进了。此即所谓的望洋兴叹吧。

如意 · 发表于 2005-3-1 20:05

谢谢你守柔[em02]

ssq1109 · 发表于 2006-8-17 17:58

今天才发现有这么好的东西，但我觉得修改一下达到下列要求更为实用：

因为使用此功能时一般不会是一个现存的文本文件，就算是，也未必是一个词一行。多为临时为一些特定的词加音标，如：在一篇WORD文档中（可能中英文文本都有）选中需要加注音标的一些词，再运行程序将这些选中的词加音标。

longstein · 发表于 2007-1-7 17:38

非常好用，太感谢了！顺便问一下大师，是否可修改一下取得音标和完整的汉语意思（有的单词汉语意思有几条）？望不吝赐教。

gemj · 发表于 2007-3-18 23:28

老大实在是高人啊，想大家之所想，解大家之所急！现在，我的眼里，我的心目中，最伟大的人就是守柔大哥了！

我用老大的这个宏，给一篇文档加注音标时，出现了一点小问题。

这篇文档总共有5494个单词，运行之后，绝大多数都完美地给添加上了，但有两个小问题：

一、有大概300多没能加上，它说没找到，原因不是没这个单词，而是它找的时候自动在这些单词前面加了个C模样的字母，但仔细分析一下好象也不是英文字母C。不知这是何故；

二、有些单词是加上了，但它加的不是这个单词的音标，而是上一个单词的音标。

老大在保重身体的同时，有空的时候可不可以把这个稍微再研究一下？仔细研读了老大的另外一篇帖子，感觉老大的意思好象是这么调用本来就不太稳定，呵呵。

为了方便老大研究，我把没加上音标的300余单词单独提取出来，又重新加了一遍音标，所得结果就是下面的这个WORD文档，里面有我说的这些问题。

另外，老大的WORD接触，我看的是爱不释手啊，如果没有异议，我可以把你的这个部杰作也放在咱们的网站上为老大宣传一下，以滴水报老大涌泉之恩，呵呵！

5y8vkneS.rar (20.55 KB, 下载次数: 211)

守柔 · 发表于 2007-3-19 06:08

QUOTE:

以下是引用gemj在2007-3-18 23:28:00的发言：

另外，老大的WORD接触，我看的是爱不释手啊，如果没有异议，我可以把你的这个部杰作也放在咱们的网站上为老大宣传一下，以滴水报老大涌泉之恩，呵呵！

谢谢gemj!

能告诉我你的网站地址吗?

守柔 · 发表于 2007-3-19 06:42

我在上次为雨雪霏霏做了程序中(http://club.excelhome.net/dispbbs.asp?boardid=23&replyid=634298&id=205492&page=1&skin=0&Star=2),略作修改.

我初步检查了一遍,有四个单词能正确标注,系单词本身错误或者以复数但词霸中未能直接识别的.

XqEkMvFc.rar (59.47 KB, 下载次数: 14693)

希望gemj兄将全部单词文档上传,我做进一步测试.

[此贴子已经被作者于2007-3-19 6:42:24编辑过]

gemj · 发表于 2007-3-19 11:47

QUOTE:

以下是引用守柔在2007-3-19 6:08:00的发言：

谢谢gemj!

能告诉我你的网站地址吗?

我们的网址是：http://www.TopSage.com

呵呵，你先看一下，没问题我们就在论坛置顶宣传，呵呵！

gemj · 发表于 2007-3-21 15:05

已经做好了，请老大看看合适不合适，有没有需要修改或增加的内容：

http://bbs.topsage.com/dispbbs.asp?boardid=22&id=119524

先总置顶，过段时间改为在计算机等版块置顶，呵呵

		自动登录	找回密码
密码			免费注册