Excel 在VBA中查找单词的英文定义

在Excel中，如果我在单元格中输入单词“PIZZA”，选择它，然后按住SHIFT+F7键，我就可以在英语词典中找到我最喜欢的食物的定义。很酷。 但我想用一个函数来做这个。类似于“=定义（“比萨饼”）”的东西

---

是否有办法通过VBA脚本访问Microsoft的研究数据？我曾考虑使用一个JSON解析器和一个免费的在线词典，但Excel似乎内置了一个不错的词典。关于如何访问它有什么想法吗？

通过研究对象

Dim rsrch as Research
rsrch.Query( ...

---

要进行查询，您需要有效web服务的GUID。但是，我无法找到Microsoft内置服务的GUID。

如果VBA的研究对象不起作用，您可以尝试Google Dictionary JSON方法，如下所示：

首先，添加对“Microsoft WinHTTP服务”的引用

在看到我的疯狂的JSON解析技巧之后，您可能还想添加您最喜欢的VB JSON解析器

然后创建以下公共函数：

Function DefineWord(wordToDefine As String) As String

  ' Array to hold the response data.
    Dim d() As Byte
    Dim r As Research


    Dim myDefinition As String
    Dim PARSE_PASS_1 As String
    Dim PARSE_PASS_2 As String
    Dim PARSE_PASS_3 As String
    Dim END_OF_DEFINITION As String

    'These "constants" are for stripping out just the definitions from the JSON data
    PARSE_PASS_1 = Chr(34) & "webDefinitions" & Chr(34) & ":"
    PARSE_PASS_2 = Chr(34) & "entries" & Chr(34) & ":"
    PARSE_PASS_3 = "{" & Chr(34) & "type" & Chr(34) & ":" & Chr(34) & "text" & Chr(34) & "," & Chr(34) & "text" & Chr(34) & ":"
    END_OF_DEFINITION = "," & Chr(34) & "language" & Chr(34) & ":" & Chr(34) & "en" & Chr(34) & "}"
    Const SPLIT_DELIMITER = "|"

    ' Assemble an HTTP Request.
    Dim url As String
    Dim WinHttpReq As Variant
    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

    'Get the definition from Google's online dictionary:
    url = "http://www.google.com/dictionary/json?callback=dict_api.callbacks.id100&q=" & wordToDefine & "&sl=en&tl=en&restrict=pr%2Cde&client=te"
    WinHttpReq.Open "GET", url, False

    ' Send the HTTP Request.
    WinHttpReq.Send

    'Print status to the immediate window
    Debug.Print WinHttpReq.Status & " - " & WinHttpReq.StatusText

    'Get the defintion
    myDefinition = StrConv(WinHttpReq.ResponseBody, vbUnicode)

    'Get to the meat of the definition
    myDefinition = Mid$(myDefinition, InStr(1, myDefinition, PARSE_PASS_1, vbTextCompare))
    myDefinition = Mid$(myDefinition, InStr(1, myDefinition, PARSE_PASS_2, vbTextCompare))
    myDefinition = Replace(myDefinition, PARSE_PASS_3, SPLIT_DELIMITER)

    'Split what's left of the string into an array
    Dim definitionArray As Variant
    definitionArray = Split(myDefinition, SPLIT_DELIMITER)
    Dim temp As String
    Dim newDefinition As String
    Dim iCount As Integer

    'Loop through the array, remove unwanted characters and create a single string containing all the definitions
    For iCount = 1 To UBound(definitionArray) 'item 0 will not contain the definition
        temp = definitionArray(iCount)
        temp = Replace(temp, END_OF_DEFINITION, SPLIT_DELIMITER)
        temp = Replace(temp, "\x22", "")
        temp = Replace(temp, "\x27", "")
        temp = Replace(temp, Chr$(34), "")
        temp = iCount & ".  " & Trim(temp)
        newDefinition = newDefinition & Mid$(temp, 1, InStr(1, temp, SPLIT_DELIMITER) - 1) & vbLf  'Hmmmm....vbLf doesn't put a carriage return in the cell. Not sure what the deal is there.
    Next iCount

    'Put list of definitions in the Immeidate window
    Debug.Print newDefinition

    'Return the value
    DefineWord = newDefinition

End Function

之后，只需将功能放入您的手机：

=定义沃尔德（“狮子化”）

---

这是哪个版本的Excel？它当然可以在Excel 2010 for Windows中使用，尽管“Pizza”给了我一个“未找到结果”的提示Thesaurus@MarkBaker这里的Excel 2013也是如此。这是日文版，但英文和日文版都不流行。奇怪…这看起来很有希望。根据研究设置，看起来它们都引用了您可以使用Fiddler来检查所做的调用-看起来像SOAP。@Derek+1查找。我很难找到服务的任何参考资料好吧，这不是我想要的路线，但它工作得太好了。做得好，先生。我仍然会玩“研究”对象来娱乐，但是上面的代码是很好的。如果这个答案对你有帮助，你应该考虑把它标记为答案。在第2018年：脚本中使用的谷歌字典URL不再工作。建议？问题：关于你的“疯狂JSON配对技巧”的说明：安装这个VBJSON东西是使这个功能正常工作所必需的吗？或者你只是提到了它，而没有在这里真正相关？你好。我是一个不懂VBA的笨蛋。你能解释一下怎么做吗？如果它与其他语言兼容。谢谢