Замена названий городов - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д