Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

Перевод текста в ячейках через Google

Внимание: периодически 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 языка:[spoiler effect="blind" show="Просмотреть языки"]

  • 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 - японский

[/spoiler]


Добавил функцию перевода, которая получает текст перевода через 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 KiB, 3 115 скачиваний)

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


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 10 комментариев
  1. Ярослав:

    Добрый день! Перестала работать данная функция. Выдает #ЗНАЧ!

    • Google ввел ограничение и заблокировал возможность автоматического перевода - теперь для получения перевода необходимо вводить каптчу. Дорабатывать код долго и сложно, пока нет возможности.

  2. Ержан:

    как минимум на двух сайтах также говорится - Дорабатывать код долго и сложно, пока нет возможности.

  3. XQuader:

    У кого не работает данный код, берите рабочий вариант здесь:
    http://excelvba.ru/code/GoogleTranslate

  4. Талья:

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

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

      • Талья:

        Спасибо большое, что не оставили без внимания мой вопрос.
        Очень интересный сайт. Удачи Вам!

        • Талья, добавил альтернативный вариант(через InternetExplorer) - на данный момент работает, как будет в будущем неизвестно. Попробуйте.

          • Талья:

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

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти