Замена названий городов - VB

Узнай цену своей работы

Формулировка задачи:

Нужно написать код программы которая в документе заменит названия городов, например москва,челябинск из записью по английски. Подсчитать число замен и вывести в окно сообщений MsgBox. Для запуска программы вынести на панель инструментов кнопку.

Решение задачи: «Замена названий городов»

textual
Листинг программы
  1. '---------------------------------------------------------------------------------------
  2. ' Модуль    : modFunctions
  3. ' Автор     : EducatedFool (Игорь)                    Дата: 29.03.2011
  4. ' Разработка макросов для Excel, Word, CorelDRAW. Быстро, профессионально, недорого.
  5. ' [url]http://excelvba.ru/[/url]          ICQ: 5836318           Skype: ExcelVBA.ru
  6. ' Реквизиты для оплаты: [url]http://excelvba.ru/payments[/url]
  7. '---------------------------------------------------------------------------------------
  8.  
  9. Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, _
  10.                     Optional ByVal sourceLanguageCode$ = "")
  11.     ' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$
  12.    ' на язык resultLanguageCode$, используя сервис переводов Google Translate
  13.    Application.Volatile True
  14.     Set ADOStream = CreateObject("ADODB.Stream")
  15.     With ADOStream
  16.         .Charset = "utf-8": .Mode = 3: .Type = 2: .Open
  17.         .WriteText TextToBeTranslated: .Flush: .Position = 0
  18.         .Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
  19.     End With
  20.  
  21.     For i = 0 To UBound(ByteArrayToEncode)
  22.         iAsc = ByteArrayToEncode(i)
  23.         Select Case iAsc    ' переводим текст в кодировку, понятную Google
  24.            Case 32: sTemp$ = "+"    'space
  25.            Case 48 To 57, 65 To 90, 97 To 122: sTemp$ = Chr(ByteArrayToEncode(i))
  26.             Case Else: sTemp$ = "%" & Hex(iAsc)     'Chr(iAsc)
  27.        End Select
  28.         txt$ = txt$ & sTemp$
  29.     Next
  30.  
  31.     ' формируем ссылку, по которой Google выдаст нам файл с переводом
  32.    URL$ = "http://translate.google.com.ua/translate_a/t?client=json&text=" & _
  33.            txt$ & "&hl=" & resultLanguageCode$ & "&sl=" & sourceLanguageCode$
  34.  
  35.     Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")    ' скачиваем файл
  36.    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False": XMLHTTP.send
  37.  
  38.     If XMLHTTP.statustext = "OK" Then
  39.         LocalPath$ = Environ("TMP") & "\google.txt"
  40.         With ADOStream    ' перекодировка файла
  41.            .Type = 1: .Open: .Write XMLHTTP.responseBody
  42.             .SaveToFile LocalPath$, 2
  43.             .Close: .Type = 2: .Charset = "utf-8": .Open:
  44.             .LoadFromFile LocalPath$    ' загружаем данные из файла
  45.            Translate$ = .ReadText   ' считываем текст файла в переменную Translate$
  46.        End With
  47.  
  48.         On Error Resume Next    ' вырезаем нужный текст из ответа
  49.        Translate$ = Split(Translate$, """trans"":""")(1)
  50.         Translate$ = Split(Translate$, """,""orig")(0)
  51.         Translate$ = Replace(Translate$, "quot;", Chr(39))
  52.         If Translate$ = " null, " Then Translate$ = "Не переведено"
  53.     End If
  54.     Set XMLHTTP = Nothing: Set ADOStream = Nothing
  55. End Function
  56.  
  57. Sub TranslateRuToEn()
  58.         Dim Src$
  59.         Src = "Москва"
  60.         Debug.Print Translate(Src, "en", "ru")
  61. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы