Внимание: периодически Google вводит ограничение и изменяет алгоритмы автоматического перевода (так же иногда для получения перевода необходимо вводить каптчу). Поэтому временами функция может не работать. Некоторое время назад можно было наблюдать это. Сейчас функция работает.

На днях проводил ревизию кодов и различных примеров в файлах и нашел довольно много интересного. В том числе функцию перевода текста из ячейки Excel на разные языки при помощи сервиса Google. Посмотрел и решил её переработать и оптимизировать, т.к. в том виде, в котором она была у меня она никуда не годилась: переводила коряво, т.к. Google поменял алгоритм в формат выходных данных. Плюс надо было решить вопрос некорректной замены различных символов внутри текста. Подозреваю, что и сейчас функция далеко не идеальна. Поэтому если у кого-то возникнут ошибки - пишите комментарии, попробуем разобраться.

Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : GoogleTranslate
' DateTime  : 04.09.2013 22:55
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : 
'     Функция переводит текст, используя сервис переводов Google Translate
'     Аргументы:
'          sText       - текст для перевода. Непосредственно текст или ссылка на ячейку.
'          sResLang    - код языка, на который осуществлять перевод
'          sSourceLang - код языка, с которого переводить.
'                        Если не указывать, Google автоматом определяет язык введенного текста
'                        Доступно 74 кода языков.
'---------------------------------------------------------------------------------------
Dim objRegExp As Object
Function GoogleTranslate(ByVal sText As String, ByVal sResLang As String, _
                         Optional ByVal sSourceLang As String = "")
 
    Dim sGoogleURL As String, sAllTxt As String, sTmpStr As String, sRes As String, sTextToTranslate As String
    Dim lByte As Long, alByteToEncode, li As Long
    Dim asTmp, lPos As Long
    'раскомментировать при необходимости пересчета функции при любом изменении в книге
    'Application.Volatile True
    If objRegExp Is Nothing Then
        Set objRegExp = CreateObject("VBScript.RegExp")
        With objRegExp
            .MultiLine = True: .ignorecase = True: .Global = True
            .Pattern = "[\n;]"
        End With
    End If
    sTextToTranslate = Application.Trim(objRegExp.Replace(sText, " "))
 
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8": .Mode = 3: .Type = 2: .Open
        .WriteText sTextToTranslate
        .Flush: .Position = 0: .Type = 1: .Read 3
        alByteToEncode = .Read(): .Close
    End With
 
    'переводим текст в кодировку, понятную Google
    For li = 0 To UBound(alByteToEncode)
        lByte = alByteToEncode(li)
        Select Case lByte
        Case 32: sTmpStr = "+"
        Case 48 To 57, 65 To 90, 97 To 122: sTmpStr = Chr(alByteToEncode(li))
        Case Else: sTmpStr = "%" & Hex(lByte)
        End Select
        sAllTxt = sAllTxt & sTmpStr
    Next li
 
    'формируем ссылку для Google
    sGoogleURL = "http://translate.google.com.ua/translate_a/t?client=json&text=" & _
                 sAllTxt & "&hl=" & sResLang & "&sl=" & sSourceLang
    sGoogleURL = Replace(sGoogleURL, "\", "/") '"
    'получаем ответ от Google
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", sGoogleURL, "False": .send
        If .statustext = "OK" Then
            sTmpStr = .responsetext
            'отбираем только переведенный текст
            asTmp = Split(sTmpStr, "{""trans"":""")
            For li = LBound(asTmp) To UBound(asTmp)
                lPos = InStr(1, asTmp(li), """,""orig"":", 1)
                If lPos Then sRes = sRes & Mid(asTmp(li), 1, lPos - 1)
            Next li
            If sRes = "" Then sRes = "Не удалось перевести"
        End If
    End With
    GoogleTranslate = sRes
End Function

Выложенный выше код является функцией пользователя для вызова из ячейки листа.

Синтаксис функции:
с английского на русский A1 записан текст на английском - Google автоматом определяет язык):
=GoogleTranslate(A1;"ru")
с английского на русский - текст задан константой:
=GoogleTranslate("translation"; "ru")

sText - текст для перевода. Непосредственно текст или ссылка на ячейку.
sResLang - код языка, на который осуществлять перевод.
sSourceLang - Необязательный аргумент. Указывается код языка, с которого переводить. Если не указывать, Google автоматом определяет язык введенного текста.

Всего доступно 74 языка:

  • en - английский
  • ru - русский
  • az - азербайджанский
  • sq - албанский
  • en - английский
  • ar - арабский
  • hy - армянский
  • af - африкаанс
  • eu - баскский
  • be - белорусский
  • bn - бенгальский
  • bg - болгарский
  • bs - боснийский
  • cy - валлийский
  • hu - венгерский
  • vi - вьетнамский
  • gl - галисийский
  • nl - голландский
  • el - греческий
  • ka - грузинский
  • gu - гуджарати
  • da - датский
  • iw - иврит
  • yi - идиш
  • id - индонезийский
  • ga - ирландский
  • is - исландский
  • es - испанский
  • it - итальянский
  • kn - каннада
  • ca - каталанский
  • zh-TW - китайский (традиционный)
  • zh-CN - китайский (упрощенный)
  • ko - корейский
  • ht - креольский (Гаити)
  • km - кхмерский
  • lo - лаосский
  • la - латынь
  • lv - латышский
  • lt - литовский
  • mk - македонский
  • ms - малайский
  • mt - мальтийский
  • mr - маратхи
  • de - немецкий
  • no - норвежский
  • fa - персидский
  • pl - польский
  • pt - португальский
  • ro - румынский
  • ru - русский
  • ceb - себуанский
  • sr - сербский
  • sk - словацкий
  • sl - словенский
  • sw - суахили
  • tl - тагальский
  • th - тайский
  • ta - тамильский
  • te - телугу
  • tr - турецкий
  • uk - украинский
  • ur - урду
  • fi - финский
  • fr - французский
  • hi - хинди
  • hmn - хмонг
  • hr - хорватский
  • cs - чешский
  • sv - шведский
  • eo - эсперанто
  • et - эстонский
  • jw - яванский
  • ja - японский

Добавил функцию перевода, которая получает текст перевода через Internet Explorer. Получается медленнее и не у всех сможет работать исключительно потому, что IE капризный и очень чувствителен к тому, какая его версия на какой ОС установлена. Но это больше исключение - в подавляющем большинстве случаев работать должно без проблем:

Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : GoogleTranslate_IE
' DateTime  : 12.04.2018 22:55
' Author    : The_Prist(Щербаков Дмитрий)
'             Профессиональная разработка приложений для MS Office любой сложности
'             Проведение тренингов по MS Excel
'             http://www.excel-vba.ru
'             info@excel-vba.ru
'             WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' Purpose   :
'     Функция переводит текст, используя сервис переводов Google Translate
'     Аргументы:
'          sText       - текст для перевода. Непосредственно текст или ссылка на ячейку.
'          sResLang    - код языка, на который осуществлять перевод
'          sSourceLang - код языка, с которого переводить.
'                        Если не указывать, Google автоматом определяет язык введенного текста
'                        Доступно 74 кода языков.
'---------------------------------------------------------------------------------------
Dim IE As Object
Function GoogleTranslate_IE(ByVal sText As String, _
                         Optional ByVal sResLang As String = "en", _
                         Optional ByVal sSourceLang As String = "auto") As String
    Dim isIEOpen As Boolean
    'подключаемся к InternetExplorer
    On Error Resume Next
    Set IE = GetObject(, "InternetExplorer.application")
    'IE еще не запущен - запускаем
    If IE Is Nothing Then
        Set IE = CreateObject("InternetExplorer.application")
        'делаем окно IE скрытым
        IE.Visible = False
    End If
    'переходим на страницу перевода и указываем параметры
    IE.navigate "https://translate.google.com/#" & sSourceLang & "/" & sResLang & "/" & sText
    'ждем отклика от IE
    Do While IE.Busy Or IE.readyState <> 4
        DoEvents
    Loop
    'получаем текст перевода
    GoogleTranslate_IE = IE.Document.getElementById("result_box").innerText
    'если IE не был запущен до вызова функции - закрываем
    If Not isIEOpen Then
        IE.Quit
        Set IE = Nothing
    End If
End Function

Функция будет работать быстрее, если перед переводом запустить InternetExplorer. Это заставит функцию использовать уже запущенный экземпляр IE, а не запускать для каждой ячейки новый(что отнимает немало времени).

Скачать пример:

  Tips_Macro_GoogleTranslate.xls (53,5 КиБ, 6 803 скачиваний)

Так же см.:
Транслит — Перевод с транслита и обратно

Loading

10 комментариев

  1. Уважаемый Дмитрий!
    Была очень рада найти желанный код, но, к сожалению, функция не работает.
    Есть информация по ограничениям, наложенным Google?
    Буду очень признательна за ответ.

    1. Талья, Google очень основательно подошел к защите своего переводчика и автоматизированно сейчас достать перевод стало очень сложно(если вообще возможно). Поэтому рабочей функции сейчас нет.

          1. Дмитрий, спасибо огромное, все работает! Это так облегчит мне жизнь.
            Преклоняюсь ))))

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.