Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Переводчик текстов
 
#1
26.03.2011 14:53:27
Давно хотел поделиться данным скриптом.    
В копилку идей не смог вложить. Думаю будет полезна данная функция для многих.  
 
Сразу оговорю скрипт не мой, в таких вещах не силен, откуда спёр не помню.  
Для перевода используется Google переводчик,    
Пример формул:  
Если требуется определить код языка, допустим хочу перевести с анг. на китайский традиционный.  
заходим в http://translate.google.ru/  
выбираем язык с "английского" на "китайский традиционный"  
в браузере возникает ссылка  
http://translate.google.ru/?hl=ru&tab=wT#en|zh-TW|  
код соответственно для английского будет "en", для китайского традиционного "zh-TW"  
и формула соответственно =translate(A1;"en";"zh-TW"), где A1 переводимая ячейка.  
 
Сам код:  
 
Public Function translate(textToBeTranslated As String, resultLanguageCode As String, Optional sourceLanguageCode As String = "") As String  
 
   Dim objhttp As Object  
   Dim URL As String  
 
   Dim i As Integer  
   Dim iAsc As Long  
   Dim sAsc As String  
   Dim sTemp As String  
 
   Dim objStream As Object  
   Dim data() As Byte  
   Dim ByteArrayToEncode() As Byte  
 
 
   Set objStream = CreateObject("ADODB.Stream")  
   objStream.Charset = "utf-8"  
   objStream.Mode = 3  
   objStream.Type = 2  
   objStream.Open  
   objStream.WriteText textToBeTranslated  
   objStream.Flush  
   objStream.Position = 0  
   objStream.Type = 1  
   objStream.Read 3  
   data = objStream.Read()  
   objStream.Close  
   ByteArrayToEncode = data  
 
 
   textToBeTranslated = ""  
 
 
   For i = 0 To UBound(ByteArrayToEncode)  
       iAsc = ByteArrayToEncode(i)  
       Select Case iAsc  
           Case 32    'space  
               sTemp = "+"  
           Case 48 To 57, 65 To 90, 97 To 122  
               sTemp = Chr(ByteArrayToEncode(i))  
           Case Else  
               Debug.Print iAsc  
               sTemp = "%" & Hex(iAsc)  
       End Select  
       textToBeTranslated = textToBeTranslated & sTemp  
   Next  
 
 
   Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")  
   URL = "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & textToBeTranslated & "&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
 
 
 
#2
26.03.2011 16:19:48
Отлично работает!  
Jnas, спасибо огромное.
 
 
 
#3
26.03.2011 16:46:46
Супер!!! Отличный скрипт! Спасибо огромное.
 
 
 
#4
26.03.2011 17:19:26
Jnas, спасибо за функцию  
Добавил себе в копилку: http://excelvba.ru/code/GoogleTranslate
 
 
 
#5
26.03.2011 18:16:50
Вещь! Спасибо огромное.
 
 
 
#6
27.03.2011 20:48:50
Не могли бы вы для чайников пояснить, куда записывать скрипт и формулу. У меня почему-то не работает. Пожалуйста!
 
 
 
#7
27.03.2011 20:53:19
<EM>http://www.excel-vba.ru/index.php?file=Tips_General_UDF</EM>
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
27.03.2011 20:59:24
Посмотрите, плиз, что не правильно делаю?
 
 
 
#9
27.03.2011 21:01:32
Вы дублируете функцию и в модуле листа, и в стандартном. Нужно оставить код функции только в стандартном модуле, а из модуля листа удалить.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#10
27.03.2011 21:03:06
Я оказывается ввел всех в заблуждение  
надо писать наоборот , в Вашем примере    
=translate(A1;"ru";"en")  
с анг. на русский
 
 
 
#11
27.03.2011 21:12:05
Спасибо за помощь! Оставила скрипт в стандартном модуле, но теперь почему-то вот что получается. Почему не может перевести?
 
 
 
#12
27.03.2011 21:13:30
Ой, поздно увидела, сейчас попробую. Спасибо!
 
 
 
#13
27.03.2011 21:23:59
Теперь переводит, но есть проблема. Первые несколько слов перевелись, а вот для перевода остальных нужно дважды кликнуть в каждой ячейке.
 
 
 
#14
27.03.2011 21:29:13
Чтобы не кликать дважды в каждой ячейке: выделяете столбец с функцией-    
Ctrl+H  
Найти: =  
Заменить на: =
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#15
27.03.2011 21:38:58
А если, как у меня, в 99% требуется перевод с английского на русский, есть смысл записать  
Public Function translate(textToBeTranslated As String, Optional resultLanguageCode As String = "ru", Optional sourceLanguageCode As String = "en") As String
 
 
 
#16
27.03.2011 21:48:11
после первой попытки помогло, но некоторые слова не перевелись. Попробовала применить замену еще раз и... все, все оказалось не переведено. Все дальнейшие попытки ничего не меняют - несколько слов переводится, а остальное - вручную.
 
 
 
#17
27.03.2011 22:00:25
RAN, спасибо, поменяла. Практически все перевелось автоматом, но несколько слов - не перевелось. Опять решила применить "замену" и опять практически везде пишет "не переведено".    
The Prist, простите ради бога за тугомыслие. У других, похоже, таких проблем не возникает, хочется понять, что же я не так делаю.
 
 
 
#18
27.03.2011 22:11:55
Это уже наверное к Гуглу.  
Попробуйте String и string, Long и long.
 
 
 
#19
27.03.2011 22:36:38
Вряд ли в гугле, так как одно и то же слово то переводится, то не переводится. Вот сейчас пробовала перепротягивать формулу с последнего переведенного слова, так постепенно все и перевела:))).    
Спасибо за помощь!  
А скрипт классный, время экономит здорово!
 
 
 
#20
27.03.2011 23:20:11
Большое Спасибо.
 
 
 
#21
28.03.2011 17:49:25
{quote}{login=чайник}{date=27.03.2011 10:36}{thema=}{post}Вряд ли в гугле, так как одно и то же слово то переводится, то не переводится. Вот сейчас пробовала перепротягивать формулу с последнего переведенного слова, так постепенно все и перевела:))).    
Спасибо за помощь!  
А скрипт классный, время экономит здорово!{/post}{/quote}  
 
Вы создаете слишком много запросов и это идет от Google,  
Пока решение нашел только одно переводит не все ячейки, а несколько    
и если уж не переводит, то подождать , скопировать и вставить формулу обратно
 
 
 
#22
28.03.2011 22:16:23
А нельзя ли убрать цикл из кода и сделать так?  
 
Public Function Translate2(textToBeTranslated As String, Optional resultLanguageCode As String = "ru", Optional sourceLanguageCode As String = "en") As String  
   Dim objhttp As Object, URL As String  
 
   textToBeTranslated = Replace(textToBeTranslated, " ", "+", 1, , vbTextCompare)  
   Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")  
   URL = "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q=" & textToBeTranslated & "&langpair=" & sourceLanguageCode & "%7C" & resultLanguageCode  
   objhttp.Open "GET", URL, False  
   objhttp.setTimeouts 1000000, 1000000, 1000000, 1000000  
   objhttp.send ("")  
   Translate2 = objhttp.responseText  
   Translate2 = Right(Translate2, Len(Translate2) - InStr(1, Translate2, "translatedText") - 16)  
   Translate2 = Left(Left(Translate2, InStr(1, Translate2, Chr(34)) - 1), 255)  
   Translate2 = Replace(Translate2, "quot;", Chr(39))  
   If Translate2 = " null, " Then Translate2 = "Не переведено"  
   Set objhttp = Nothing  
End Function
 
 
 
#23
28.03.2011 22:20:36
Правда, я не тестировал полученный результат ))
 
 
 
#24
28.03.2011 22:24:50
Есть подозрение, что без данного цикла может вернуть кракозябры вместо нормального текста при переводе на русский или с русского.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#25
28.03.2011 22:35:41
Потестировал, да, кракозябли ... надо подумать
 
 
 
#26
28.03.2011 22:50:21
Интересно, как обойти недостаток, что массив data() может быть только byte, т.е. всего можно перевести 256 символов, а если страка длинее ?  
 
P.S. Кстати, думаю 2 массива много, можно оставить одни либо data(), либо ByteArrayToEncode()
 
 
 
#27
29.03.2011 08:59:03
Попробовал дома.  
Отлично работает.  
А на работе интернет кастрирован проксёй и файерволлами - не идёт. Выдаёт ошибку "A connection with the server could not be established" на попытке objhttp.send ("")  
Обидно... Как раз на работе-то эта фенечка и пригодилась бы...  
Вот как бы её заставить настройки сети у броузера по умолчанию брать...
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
 
 
#28
29.03.2011 11:50:39
Выложил пример использования этой функции на листе Excel:  
http://excelvba.ru/code/GoogleTranslate  
 
 
> А на работе интернет кастрирован проксёй и файерволлами - не идёт  
здесь описывалось решение: http://excelvba.ru/code/GetHTTPResponse  
 
надо попробовать добавить 2 строки кода после objhttp.Open "GET", URL$, False:  
 
objhttp.setProxy 2, "192.168.100.1:3128"  
objhttp.setProxyCredentials "user", "password"  
 
 
> А нельзя ли убрать цикл из кода и сделать так?  
а зачем убирать цикл??? он выполняется за тысячные доли секунды - чем он вам мешает?
 
 
 
#29
29.03.2011 12:01:19
EducatedFool, Игорь, согласен, цикл выполняется быстро и можно его оставить.  
А что ты думаешь, чтобы убрать один из массивов, например, data()
 
 
 
#30
29.03.2011 13:02:02
{quote}{login=Windows 7}{date=29.03.2011 12:01}{thema=}{post}А что ты думаешь, чтобы убрать один из массивов, например, data(){/post}{/quote}  
Я уже итак убрал из кода почти всё лишнее - там нет никаких масcивов data...
 
 
 
Страницы: 1 2 След.
Наверх