Внимание: периодически 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 автоматом определяет язык):
с английского на русский - текст задан константой:
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 780 скачиваний)
Так же см.:
Транслит — Перевод с транслита и обратно
Добрый день! Перестала работать данная функция. Выдает #ЗНАЧ!
Google ввел ограничение и заблокировал возможность автоматического перевода - теперь для получения перевода необходимо вводить каптчу. Дорабатывать код долго и сложно, пока нет возможности.
как минимум на двух сайтах также говорится - Дорабатывать код долго и сложно, пока нет возможности.
У кого не работает данный код, берите рабочий вариант здесь:
http://excelvba.ru/code/GoogleTranslate
XQuader, проверьте код из статьи: он уже работает давно, т.к. Google снял ограничение по капче.
Уважаемый Дмитрий!
Была очень рада найти желанный код, но, к сожалению, функция не работает.
Есть информация по ограничениям, наложенным Google?
Буду очень признательна за ответ.
Талья, Google очень основательно подошел к защите своего переводчика и автоматизированно сейчас достать перевод стало очень сложно(если вообще возможно). Поэтому рабочей функции сейчас нет.
Спасибо большое, что не оставили без внимания мой вопрос.
Очень интересный сайт. Удачи Вам!
Талья, добавил альтернативный вариант(через InternetExplorer) - на данный момент работает, как будет в будущем неизвестно. Попробуйте.
Дмитрий, спасибо огромное, все работает! Это так облегчит мне жизнь.
Преклоняюсь ))))