1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
|
Option Explicit
Sub test()
MsgBox Translate(Cells(4, 3), "fr", "it")
'formule: "=Translate(cellule; "fr"; "en")
End Sub
'
Public Function Translate(rng As Range, Optional From As String = "en", Optional ToLang As String = "fr") As String
Dim Req As Object, URL As String, code As String, elem As Object, x As Long
Set Req = CreateObject("MSXML2.ServerXMLHTTP")
URL = "https://translate.google.pl/m?hl=fr&sl=" & From & "&tl=" & ToLang & "&ie=UTF-8&prev=_m&q=" & rng.Text
'Debug.Print URL
Req.Open "GET", URL, False
Req.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
Req.send ("")
code = Req.responsetext
'Debug.Print code
With CreateObject("htmlfile")
.body.innerhtml = code
For Each elem In .all
If Not IsNull(elem.getattribute("dir")) And elem.tagname = "DIV" Then x = x + 1
'Debug.Print elem.innertext
If x = 3 Then Translate = elem.innertext: Exit For
Next
End With
End Function |
Partager