[求助]为英语生词自动生成词汇表

2005-2-25老大编写了一个《[分享]WORD与金山词霸-自动标注音标的小程序》http://club.excelhome.net/viewthread.php?tid=83613&replyID=&skin=0

　　老大的这个程序，小弟很久前就开始使用了，为小弟的英语学习带来了极大的帮助！感谢老大在sendkey方面的创意！相信这个程序已经给论坛里的兄弟们带来许多好处！

　　以上是在原帖四楼兄弟的话，这确实是一种情况，那就是我们在Word里浏览英语文章时，看到某个单词，知道它的意思，但不知道它的读音，或者说这个单词的读音非常特殊或容易混淆，这时，如果能够利用宏直接将这个单词的音标标注于这个单词的右侧，以后再看这文章时，就比较有底了。
　　四楼兄弟所说，应该说有一定的用处，但若是只求文章阅读时的某个单词的读音什么的，其实金山词霸本身就已经提供了极强大的“即时显示”“即时发音”的功能，因此，倒也不是非常急着需要进行另外的编程。

　　老大的代码，目的是专为着“批量”处理，亦即我们在阅读英语文章时，一看到不懂的单词，就把它复制到一个新的Word文档中，要求是一个单词一行，而后运行老大的程序，自动为所有单词标上音标。

　　小弟在实际使用中，为了方便单词的复习，使用老大的程序标注了音标之后：
　　①利用“文字转换为表格”功能，将生词与音标放到了表格中，各占一列。
　　②再于这两列的右侧，新增了一个第三列。
　　③将鼠标悬停于某个生词之上，点金山词霸自身的“即时显示”区里的“复制（单词信息）”按钮。
　　④再将这个生词的注释“粘贴”到Word表格的第三列对应单元格。
　　⑤于这单元格里删去复制单词信息时带来的生词本身与音标（这时的音标以“乱码”的形式出现）。
　　这样，就生成了一个“词汇表”，第一列是生词，第二列是用老大的程序标注的音标，第三列是手动从金山词霸里复制来的中文释义（复制信息中已包括词性）。
　　小弟的问题是：请问老大，能不能为这些生词也自动标注中文释义（包括词性）呢？即用VBA自动完成小弟手工操作的内容。

　　难点有三：
　　①最终的结果，是生成一个表格。
　　这主要是因为每一个单词有好几种词性，每种词性的中文释义都各自为一段，为了其他诸如统计、排序、修饰的需要，要求表格的“一行”就是只对应一个单词。
　　②只复制“即时显示”区里的单词信息。
　　纯粹用金山词霸查某个单词，在金山词霸的界面当中，这个单词的释义非常多，还有很多例句，要把这些东西全部复制到Word中，完全没有必要。
　　因此，只要求复制到“词汇表格”第三列的内容是，当鼠标悬停于生词之上时“即时显示”出来的内容，即那个浮动方框里的内容。
　　③在第三列将复制来的单词信息里的冗余去除。
　　因为浮动框里包括了单词、音标、词性、中文释义四个方面的内容，把它们全部粘贴到了第三列后，应该将与第一列、第二列内容重复的“单词”、“音标”两项去掉。
　　“单词”“音标”往往是在复制信息的第一段与第二段。
　　但情况也有意外的：如果一些单词没有音标，复制信息里就没有音标这一段了，单词的下一段就是词性与中文释义。
这样，其实就要求，对复制信息的第一段（单词），可以直接删除；而对第二段（可能是音标，也可能是中文释义）能不能删除，则要进行智能判断——如果这一段确实是音标则删去，如果是词性与中文释义则不删除。
对于是不是音标，老大会有很多的方法去进行最正确的判断。小弟觉得似乎也可以考虑一下这样的判断条件——音标往往是在方括号中的——即[ ]中。（当然，难保在中文释义中不出现方括号。）

　　如果能自动生成这样的“词汇表”，小弟的英语学习效率将会高许多，不然，如果有大量的生词需要进行这样的处理，手工去操作实在是费时费力。

　　每次都是“临事抱老大的佛脚”，都是“无事不登三宝殿”，这样的小弟实在该远贬天涯！请老大发落！

烦劳雨兄给个实例，它有你平时的含有英文的文档，以及你需要手动工作的一些内容（请标识），这样，我可以省却这些所谓的工作。

我说明一点，这个东东也许不太好弄，因为词霸版本的不同，可能会有一些意想不到的困难，所以，需要时间，需要共同的测试。

老大又不皱一下眉头就过来帮忙了！谢谢老大帮助小弟从来不说一个“烦”字！

以下是附件，请老大查看。

小弟使用的是金山词霸2006。昨晚下了一个金山词霸2007，要通行证密码什么的，小弟没办法弄，只好仍然使用金山词霸2006了。

  3SvTw3uo.rar (22.89 KB, 下载次数: 162)

以下代码供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By Zhjp@ExcelHome 2006-12-11 16:34:05
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 00061^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit
Private WithEvents wdApp As Word.Application

Sub Example()
'本程序仅在金山词霸2003上正确通过
    Dim myRange As Range, myTable As Table, TF As Boolean
    Dim EngWord As String, myString() As String, myRow As Row
    Dim aString As String, bString As String, cString As String
    Dim KeyString As String
    If Tasks.Exists("金山词霸") = False Then
        MsgBox "您必须先运行金山词霸程序!!", vbCritical, "ExcelHome"
        Exit Sub   '如果未在任务栏中则关闭程序
    End If
    With Selection
        '如果不是光标状态则退出(非选定内容状态)
        If .Type <> wdSelectionIP Then Exit Sub
        EngWord = .Words(1)
        '如果光标后的单词不是英文单词则退出
        If Not EngWord Like "[A-z]*" Then Exit Sub
    End With
    Application.ScreenUpdating = False    '关闭屏幕更新
    bString = GetPhonetic(EngWord)    '以得词霸中的内容
    myString = VBA.Split(bString, vbCrLf)    '返回一个数组
    aString = myString(1)    '取得数组中的第二个值,也就是音标
    cString = myString(0)    '单词本身(也许是相近的单词)
    bString = VBA.Replace(bString, cString & vbCrLf, "")
    bString = VBA.Replace(bString, aString & vbCrLf, "")
    '    MsgBox bString
    '    MsgBox aString
    KeyString = "----------我的生词表----------"
    With ActiveDocument
        Set myRange = .Content
        With myRange.Find
            .ClearFormatting
            .Text = KeyString & "^p"
            TF = .Execute
        End With
        If TF = True Then
            myRange.SetRange myRange.Start, .Content.End - 1

                    Else

                        .Text = aString

                        .SetRange .Start + 1, .End - 3

                        .Font.Name = "Kingsoft Phonetic Plain"

                    End If

                End With

                .Cells(4).Range.Text = bString

            End With

            .Range.Fields.Update

        End With

    End With

    Application.ScreenUpdating = True

End Sub

'----------------------

Function GetPhonetic(EwTxt As String) As String

    Dim MyData As DataObject

    On Error Resume Next

    Tasks("金山词霸").WindowState = wdWindowStateNormal    '正常窗口

    Set MyData = New DataObject    '引用DataObject

    Tasks("金山词霸").Activate    '激活金山词霸应用程序

    SendKeys EwTxt, True    '发送单词

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

    SendKeys "^c", True    '复制

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

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

    MyData.Clear '清空剪贴板

    AppActivate "Microsoft Word"     '激活WORD文档

End Function

'----------------------

Private Sub Document_Open()

'指向Application对象

    Set wdApp = Word.Application

End Sub

'----------------------

Private Sub wdApp_WindowBeforeRightClick(ByVal Sel As Selection, Cancel As Boolean)

'修改右键菜单

    If Sel.Type = wdSelectionIP Then

        If VBA.InStr(Word.CommandBars("Text").Controls(1).Caption, "To") Then

            Word.CustomizationContext = ActiveDocument

            If Sel.Words(1) Like "[A-z]*" Then

                Word.CommandBars("Text").Controls(1).Caption = Sel.Words(1) & " To 生词表"

                Word.CommandBars("Text").Controls(1).Visible = True

            Else

                Word.CommandBars("Text").Controls(1).Visible = False

            End If

        End If

    End If

End Sub

'----------------------

成品见附件，仅需右击，无需选定

wMfLKZq4.zip (30.5 KB, 下载次数: 176)

2006-12-11 16:44 上传

点击文件名下载附件
[求助]为英语生词自动生成词汇表

我做一个，你前在三步。即

QPjI1JYE.rar (13.66 KB, 下载次数: 137)