Замена названий городов - 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

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


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

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

14   голосов , оценка 4 из 5
Похожие ответы