'собственно сама функция - ей передаются по значению аргументы:
' 1) текст для перевода
' 2) язык, на который нужно перевести
' 3) исходный язык (опционально), иначе - автоопределение Googl-ом
Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, _
Optional ByVal sourceLanguageCode$ = "")
On Error Resume Next 'игнорирование любых критических ошибок при выполнении кода
' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$
' на язык resultLanguageCode$, используя сервис переводов Google Translate
' Application.Volatile True 'форсировать автообновление формул
Set ADOStream = CreateObject("ADODB.Stream") 'создаем экземпляр объекта ADO.Stream
' часть ниже преобразовует в UTF-8 без BOM (хидера) текст для перевода
With ADOStream
'кодировка - UTF-8, режим работы - adModeReadWrite (чтение и запись), тип данных - 2 - текст
.Charset = "utf-8": .Mode = 3: .Type = 2: .Open
'записываем в поток текст, обновляем, устанавливаем позицию курсора в 0
.WriteText TextToBeTranslated: .Flush: .Position = 0
'переключаем тип на бинарный, читаем первые 3 байта (таким образом игнорируем их)
'читаем в переменную остальную часть, закрываем поток
.Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
End With
' Эта часть пробразовует текст в URL-Encode
For i = 0 To UBound(ByteArrayToEncode)
iAsc = ByteArrayToEncode(i)
Select Case iAsc ' переводим текст в кодировку, понятную Google
Case 32: sTemp$ = "+" 'space
Case 48 To 57, 65 To 90, 97 To 122: sTemp$ = Chr(ByteArrayToEncode(i))
Case Else: sTemp$ = "%" & Hex(iAsc) 'Chr(iAsc)
End Select
txt$ = txt$ & sTemp$
Next
' формируем ссылку, по которой Google выдаст нам файл с переводом
URL$ = "http://translate.google.com.ua/translate_a/t?client=json&text=" & _
txt$ & "&hl=" & resultLanguageCode$ & "&sl=" & sourceLanguageCode$
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") ' скачиваем файл
' Отправляем GET-запрос
XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False": XMLHTTP.send
If XMLHTTP.statustext = "OK" Then
LocalPath$ = Environ("TMP") & "\google.txt"
With ADOStream ' перекодировка файла
.Type = 1: .Open: .Write XMLHTTP.responseBody
' сохраняем ответ сайта во временный файл
.SaveToFile LocalPath$, 2
.Close: .Type = 2: .Charset = "utf-8": .Open:
.LoadFromFile LocalPath$ ' загружаем данные из файла
Translate$ = .ReadText ' считываем текст файла в переменную Translate$
End With
' часть выше написана ущербно - можно было обойтись и без временного файла
On Error Resume Next
' вырезаем нужный текст из ответа, находя параметр "trans" и "orig"
Translate$ = Split(Translate$, """trans"":""")(1)
Translate$ = Split(Translate$, """,""orig")(0)
Translate$ = Replace(Translate$, "quot;", Chr(39))
If Translate$ = " null, " Then Translate$ = "Не переведено"
End If
Set XMLHTTP = Nothing: Set ADOStream = Nothing 'очищаем объекты
End Function
