查找单词的英文定义VBA

Question

在Excel中，如果我输入单词“PIZZA”成一个单元格，选择它，SHIFT + F7，我可以得到我最喜欢的食物好听的英文字典的定义。很酷。 但我想要一个这样做的函数。像'= DEFINE（“PIZZA”）'。

是否有通过VBA脚本的方法来访问微软的研究数据？我正在考虑使用JSON解析器和一个免费的在线字典，但看起来Excel有一个很好的字典内置。有关如何访问它的任何想法？

Answer 1

如果VBA的研究对象不工作了，你可以试试谷歌字典JSON方法像这样：

首先，添加一提到“微软的WinHTTP服务”。

后你看我疯了，JSON解析的skillz，你可能还需要添加自己喜欢的VB JSON解析器，like this one。

然后创建下列公共功能：

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 

在此之后，它只是一个把功能在你的细胞的事情：

= DefineWord（ “lionize”）

Answer 2

通过研究对象

Dim rsrch as Research 
rsrch.Query(... 

要查询，您需要一个有效的Web服务的GUID。尽管如此，我还是无法找到微软内置服务的GUID。