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

雨雪霏霏

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

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

QUOTE:

以下是引用ssq1109在2006-8-17 17:58:00的发言：

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

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

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

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

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

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

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

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

[此贴子已经被作者于2006-12-8 11:26:33编辑过]

守柔

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

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

雨雪霏霏

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

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

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

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

2006-12-8 12:47 上传

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

雨雪霏霏

　　以下是小弟对于自动生成词汇表的思路，请老大指点：
　　
　　一、取得词汇——这一步由手工完成：
　　①、在阅读英语文章时，看到一个生词，就将“复制”这个生词；
　　②、新建一个Word文档（姑称之为“副文档”。它只是作为临时文档，不需要将这个文档“保存”）。
　　③、点“选择性粘贴→无格式文本”（当然，直接粘贴也可。这里主要为了格式的统一），将这个生词粘贴到副文档中。
　　这样反复，副文档中便有了很多生词，每个生词独立一行（也可称为独立一段）。
　　
　　二、生成词汇表——这一步由VBA完成：
　　
　　在副文档中，一按“生成词汇表”按钮，这个宏将执行以下任务：
　　④、在副文档中自动新建一个表格。
　　如果将表格第一行称为A行，第一列称之1列，整个表格表示成如下形式：
　　A1　　A2　　A3
　　B1　　B2　　B3
　　C1　　C2　　C3
　　D1　　D2　　D3
　　E1　　E2　　E3
　　这个表格的行数与生词数相等，即把生词全部纳入表格第一列。
　　这个表格分为三列：1列是生词，2列、3列为空白列（不带有任何格式，即单元格里的格式为“正文”格式。这主要是避免对2、3两列进行填充内容时产生一些怪异格式）。
　　⑤、生成音标。
　　利用VBA自动查得A1生词的音标，将这个音标发送到A2中。
　　如果A1生词在金山词霸中不存在音标，则A2单元格为空。
　　⑥、生成词性与中文释义。
　　第一步：利用VBA自动查得A1生词的词性与中文释义等信息（应该是金山词霸“即时显示区”里的内容。似乎就是《简明英汉词典》的释义吧），将它们发送到A3中。
　　第二步：利用VBA将这些信息当中的冗余删除，只保留词性与中文释义。
　　这样，不断重复⑤、⑥的操作，为B2、B3单元格生成音标与释义、为C2、C3单元格生成音标与释义……生成整个词汇表。
　　
　　当然，也可将⑥里的第二步，改为生成整个词汇表后再进行，利用VBA对整个C列进行智能判断，删除冗余信息。

守柔

以下代码供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* 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

[此贴子已经被作者于2006-12-11 16:39:48编辑过]

守柔

            Set myTable = myRange.Tables(1)
        Else
            .Content.InsertAfter Chr(13) & KeyString & Chr(13)
            Set myRange = .Range(.Content.End - 1, .Content.End - 1)
            Set myTable = .Tables.Add(Range:=myRange, numrows:=2, numcolumns:=4)
            With myTable
                .Style = "网格型"
                .Cell(1, 1).Range.Text = "序"
                .Cell(1, 2).Range.Text = "生词"
                .Cell(1, 3).Range.Text = "音标"
                .Cell(1, 4).Range.Text = "释义"
                .Columns(1).PreferredWidthType = wdPreferredWidthPercent
                .Columns(1).PreferredWidth = 10
                .Columns(2).PreferredWidthType = wdPreferredWidthPercent
                .Columns(2).PreferredWidth = 20
                .Columns(3).PreferredWidthType = wdPreferredWidthPercent
                .Columns(3).PreferredWidth = 20
                .Columns(4).PreferredWidthType = wdPreferredWidthPercent
                .Columns(4).PreferredWidth = 50
            End With
        End If
        With myTable
            Set myRow = .Rows.Last
            Set myRow = .Rows.Add(myRow)
            With myRow
                .Range.Font.Name = "Tahoma"
                Set myRange = .Cells(1).Range
                With myRange
                    .SetRange .Start, .Start
                    .Fields.Add Range:=myRange, Type:=wdFieldEmpty, Text:="SEQ  生词\* ARABIC", preserveformatting:=False
                End With
                .Cells(2).Range.Text = EngWord
                Set myRange = .Cells(3).Range
                With myRange
                    If VBA.LCase(cString) <> VBA.LCase(Trim(EngWord)) Then
                        bString = "没找到!": aString = "没找到!"
                        .Text = aString
                    Else

[此贴子已经被作者于2006-12-11 16:40:47编辑过]

守柔

                    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

[此贴子已经被作者于2006-12-12 6:34:23编辑过]

守柔

    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

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

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

 今天在金山词霸2005上测试通过

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

2006-12-11 16:44 上传

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

[此贴子已经被作者于2006-12-12 6:46:11编辑过]

konggs

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

①、在阅读英语文章时，看到一个生词，就将“复制”这个生词； 　②、新建一个Word文档（姑称之为“副文档”。它只是作为临时文档，不需要将这个文档“保存”）。 　③、点“选择性粘贴→无格式文本”（当然，直接粘贴也可。这里主要为了格式的统一），将这个生词粘贴到副文档中。

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

2006-12-11 19:22 上传

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

   因为这个问题简单。呵呵。