Замена названий городов - VB
Формулировка задачи:
Нужно написать код программы которая в документе заменит названия городов, например москва,челябинск из записью по английски. Подсчитать число замен и вывести в окно сообщений MsgBox. Для запуска программы вынести на панель инструментов кнопку.
Решение задачи: «Замена названий городов»
textual
Листинг программы
'--------------------------------------------------------------------------------------- ' Модуль : modFunctions ' Автор : EducatedFool (Игорь) Дата: 29.03.2011 ' Разработка макросов для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. ' [url]http://excelvba.ru/[/url] ICQ: 5836318 Skype: ExcelVBA.ru ' Реквизиты для оплаты: [url]http://excelvba.ru/payments[/url] '--------------------------------------------------------------------------------------- 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 Sub TranslateRuToEn() Dim Src$ Src = "Москва" Debug.Print Translate(Src, "en", "ru") End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д