查找單詞的英文定義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。