Encontrar la definición en inglés de una palabra en VBA

Question

En Excel, si ingreso la palabra "PIZZA" en una celda, selecciónela, y MAYÚS + F7, obtengo una buena definición del diccionario inglés de mi comida favorita. Muy genial. Pero me gustaría una función que hace esto. Algo así como '= DEFINE ("PIZZA")'.

¿Hay alguna manera de acceder a los datos de investigación de Microsoft a través de los scripts de VBA? Estaba considerando usar un analizador JSON y un diccionario en línea gratuito, pero parece que Excel tiene un buen diccionario integrado. ¿Alguna idea sobre cómo acceder a ella?

Answer 1

En el caso objeto de investigación de VBA no sale bien, puede probar el método de Google Diccionario JSON como tan:

En primer lugar, añadir una referencia a "WinHTTP servicios de Microsoft".

Después de ver mi loca, JSON Skillz análisis, también puede querer añadir su favorito analizador JSON VB, like this one.

luego crear la siguiente Función Pública:

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 

Después de eso, es sólo una cuestión de poner la función en su celular:

= DefineWord ("agasajar")

Answer 2

a través de la investigación de los objetos

Dim rsrch as Research 
rsrch.Query(... 

Para realizar una consulta, lo que necesita el GUID de un servicio web válida. Sin embargo, no he podido encontrar los GUID para el servicio integrado de Microsoft.