在VBA中查找单词的英文定义
在Excel中，如果我在单元格中input单词“PIZZA”，select它，SHIFT + F7，我可以得到一个很好的英文字典定义我最喜欢的食物。 很酷。 但我想要一个这样的function。 像“= DEFINE（”PIZZA“）”。
有没有办法通过VBA脚本访问微软的研究数据？ 我正在考虑使用一个JSONparsing器和一个免费的在线字典，但它似乎像Excel有一个很好的字典内置。 有关如何访问它的任何想法？
如果VBA的Research对象不能解决问题，可以尝试使用Google Dictionary JSON方法：
首先，添加对“Microsoft WinHTTP服务”的引用。
当你看到我的疯狂，JSONparsing技巧，你可能也想添加你最喜欢的VB JSONparsing器， 就像这个 。
然后创build以下公用函数：
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 之后，这只是把这个function放到你的单元里的问题：
= DefineWord（ “lionize”）
通过研究对象
Dim rsrch as Research rsrch.Query( ...
要进行查询，您需要有效的Web服务的GUID。 虽然我一直无法find微软内置服务的GUID。