mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Функция перевода с одного языка на другой (с использованием Google Translate)

Данная VBA функция позволяет перевести текст с любого языка на другой
Язык исходного текста можно не указывать - Google распознает его самостоятельно.
(т.е. вызовы res$ = Translate(txt$, "en", "ru") и res$ = Translate(txt$, "en") равнозначны)

Добавлено 17.10.2011
В данный момент функция не работает для большого числа запросов - Google недавно ввёл ограничение.
Решение для обхода этого ограничения сложное, потому пока мной не реализовано (не было необходимости)
Добавлено 07.03.2012
Исправленный вариант функции вы можете найти в конце статьи. (теперь снова можно выполнять автоматизированный перевод любого количества фраз на любые языки)
Алгоритм функции немного изменился - но это и не важно, главное, что перевод снова работает.
Пример использования перевода на листе Excel - во втором прикреплённом файле

Sub ПримерИспользованияФункцииПеревода()
    txt$ = "Привет! Это функция перевода текста на иностранный язык"
    res$ = Translate(txt$, "en", "ru")
    MsgBox "Результат перевода на английский:" & vbNewLine & res$, vbInformation, txt$
    res$ = Translate(txt$, "de")
    MsgBox "Результат перевода на немецкий:" & vbNewLine & res$, vbInformation, txt$
End Sub

Список кодов доступных языков для перевода:
(используются в качестве параметров функции Translate)

ar - арабский; bg - болгарский; cs - чешский;
da - датский ; de - немецкий; el - греческий;
en - английский; es - испанский; fi - финский;
fr - французский; hi - хинди; hr - хорватский;
it - итальянский; ja - японский; ko - корейский;
nl - голландский; no - норвежский; pl - польский;
pt - португальский; ro - румынский; ru - русский;
sv - шведский; zh-cn - китайский упрощенный; zh-tw - китайский традиционный

Код функции перевода:

Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, Optional ByVal sourceLanguageCode$ = "")
    ' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$ на язык resultLanguageCode$,
    ' используя сервис переводов Google Translate
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8": .Mode = 3: .Type = 2: .Open
        .WriteText TextToBeTranslated: .Flush: .Position = 0
        .Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
    End With
 
    For i = 0 To UBound(ByteArrayToEncode)
        iAsc = ByteArrayToEncode(i)
        Select Case iAsc
            Case 32: sTemp$ = "+"    'space
            Case 48 To 57, 65 To 90, 97 To 122: sTemp$ = Chr(ByteArrayToEncode(i))
            Case Else: sTemp$ = "%" & Hex(iAsc)
        End Select
        txt$ = txt$ & sTemp$
    Next
 
    Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
    URL$ = "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & _
           txt$ & "&langpair=" & sourceLanguageCode$ & "%7C" & resultLanguageCode$
    objhttp.Open "GET", URL$, False
    objhttp.setTimeouts 1000000, 1000000, 1000000, 1000000: objhttp.send ("")
 
    Translate$ = objhttp.responseText
    Translate$ = Right(Translate$, Len(Translate$) - InStr(1, Translate$, "translatedText") - 16)
    Translate$ = Left(Left(Translate$, InStr(1, Translate$, Chr(34)) - 1), 255)
    Translate$ = Replace(Translate$, "quot;", Chr(39))
    If Translate$ = " null, " Then Translate$ = "Не переведено"
End Function


(добавлено позже)
Видоизменил функцию - теперь перевод снова работает
(пример использования - во втором прикреплённом файле)
Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, _
                    Optional ByVal sourceLanguageCode$ = "")
    ' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$
    ' на язык resultLanguageCode$, используя сервис переводов Google Translate
    Application.Volatile True
    Set ADOStream = CreateObject("ADODB.Stream")
    With ADOStream
        .Charset = "utf-8": .Mode = 3: .Type = 2: .Open
        .WriteText TextToBeTranslated: .Flush: .Position = 0
        .Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
    End With
 
    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")    ' скачиваем файл
    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    ' вырезаем нужный текст из ответа
        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

ВложениеРазмерЗагрузкиПоследняя загрузка
GoogleTranslate.xls35 КБ2085 часов 1 минута назад
GoogleTranslate_New.xls41 КБ6045 недель 2 дня назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Макрос этот не будет дорабатываться, — там теперь все сложнее с гуглом, он сейчас выдаёт капчу.

Данный макрос используется в составе программы «парсер сайтов», — там я переделаю (доработаю) код.
А в виде отдельного макросы выкладывать не буду, - так как код стал намного сложнее из-за необходимости обработки капчи.

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

Ну очень нужно перевести информацию с тайского. Массив огромный, поэтому GoogleTranslate крайне необходим. Порекомендуйте, как решить проблему, где поискать, когда доработаете макрос? С искренним уважением.

Будем очень признательны!перевод может не работает и за смены протокола на HTTPS?

Гугл недавно что-то там у себя поменял - теперь макрос перевода не работает.
Если будет время свободное, - доработаю, выложу исправленную версию.

Вы еще не нашли решение?а то у меня тоже выдает такую ошибку, а макрос ссылается на ошибку "False": XMLHTTP.send

При попытке перевода с любого языка на любой выдает ЗНАЧ. В чем может быть проблема? даже в вашем новом файле.

А в чем проблема перевода русский-украинский?
Гугл множество языков знает, - надо только указать соответствующие коды
Код русского языка - ru, код украинского - uk

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

Вот к примеру на таком
[/url]。 「韓流ショップギルズハウス」というのは,[url\=http://orob106.senmontenm.com/]オロビアンコ 財布
Но это только если использовать сам макрос, а не вставлять в ячейку.
Если вставим в пример в ячейку то получим [/ Url].

на строке
XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False": XMLHTTP.send
а именно XMLHTTP.send
выскакивает ошибка Run-time error '-2147467259 (80004005)'
как можно ее обойти, чтоб просто пропускать тогда ячейку?

Кстати, и всякие "сложные" символы обрабатываются некорректно (аксантегю в французком итп). В целом, применение в данном виде возможно только в очень узкой области.
Приходится все эти "е с штрихами" вначале на обычные e менять итп.
Мне не подошел из-за длины, часто режет.

Сергей, мой код ничего специально не обрезает.
Либо это ограничение Google, либо мой код некорректно обрабатывает ответ сервера.

Переводит, но почему-то только первые 100-200 символов. Т.е. переводы обрезаются.
Посмотрел по коду, не нашел где :(

Не знаю, в чем проблема.
У меня всё работает, - только что проверил прикреплённый файл GoogleTranslate_New.xls
Всё корректно переводится на разные языки.

Указанная вами фраза, - перевод на датский язык. Почему у вас так работает, - не знаю.

Игорь, очень интересная функция. Но не работает :-( Открыл Ваш файлик и во всех ячейках получил: "Denne funktion er oversat sætning i fremmedsprog ved hjælp af Google Translate tjeneste"
Видимо Гугл опять что-то поменял... Можете подправить? Заранее спасибо...

Игорь, спасибо за доработку очень полезной функции. Давно сюда не заглядывал, т.к. "мыло" об ответе на мой предыдущий вопрос почему-то не пришло.
Теперь UDF работает отлично даже из корпоративной сети, "кастрированный" проксями, файерволлами и антифирусами.
Одна проблема: если переводимый текст состоит из нескольких предложений, оканчивающихся в соответствии с правилами грамматики точкой, восклицательным или вопросительным знаками, то переводится только первое предложение. А всё остальное игнорируется :(
Например, из текста "Привет! Это функция перевода текста на иностранный язык", который брался в качестве примера в первом выложенном здесь варианте, на английский переведётся только "Hi!"
А если поставить вместо восклицательного знака запятую: "Привет, Это функция перевода текста на иностранный язык", то переведётся полностью :"Hi, This function translation into a foreign language"
Не хорошо это...
Может быть запрос можно как-то изменить?

Если нет, то придётся мне самому "допиливать" функцию (наверное, разобью дополнительной обвеской кодом текст на предложения, переведу по одному и сцеплю в результат полного перевода, хотя это, конечно, будут "протезы" )

В связи с тем, что прежняя функция Translate давно перестала работать,
внёс в неё заметные изменения.
(см. исправленный вариант функции перевода в конце статьи)

Во втором прикреплённом файле - работающий пример перевода текста на разные языки, с использованием сервиса Google Translate

С октября 2011 Google Translate ввел ограничения на машинный перевод через API-Google v1 и v2. На примере, приведенном выше, будет переведена лишь первая строка. А остальные - "не переведено". Они захотели денег. Теперь есть расценка за определенное число переводов. Нужно получить КЛЮЧ от Google, который необходимо добавлять в ЗАПРОС (в URL-адрес)...

Кто работает через прокси-сервер, не запускайте файл примера - ЗАВЕСИТЕ ЁКСЕЛЬ НАДОЛГО!
Ёксель не будет реагировать ни на что пока пока не окончатся выходы по 10-секундному таймауту для каждой из 24-х функций на листе.

Пример использования этой функции на листе Excel - во вложении к статье.

Используется формула =Translate($C$1;B5)

Скриншот результата:

Всеровно не разобрался куда вводить текст нужно...

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _     _____   _   ____    _             
| |_ |_ _| | | / ___| | |__ __ _
| __| | | | | \___ \ | '_ \ / _` |
| |_ | | | | ___) | | | | | | (_| |
\__| |_| |_| |____/ |_| |_| \__,_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.