Не работает макрос, посмотрите пожалуйста, что делаю не так :( [vba]
Код
Sub LatLong() Dim a, lat, lng, urladr As String a = InputBox("Место назначения (Город, адрес)", "Пункт", "") urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & Replace(a, " ", "+") & "&sensor=false" Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.Load urladr Do While xmlDoc.readyState <> 4 DoEvents Loop lat = xmlDoc.SelectSingleNode("//location/lat").Text lng = xmlDoc.SelectSingleNode("//location/lng").Text MsgBox lat & "," & lng End Sub
[/vba]
Не работает макрос, посмотрите пожалуйста, что делаю не так :( [vba]
Код
Sub LatLong() Dim a, lat, lng, urladr As String a = InputBox("Место назначения (Город, адрес)", "Пункт", "") urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & Replace(a, " ", "+") & "&sensor=false" Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.Load urladr Do While xmlDoc.readyState <> 4 DoEvents Loop lat = xmlDoc.SelectSingleNode("//location/lat").Text lng = xmlDoc.SelectSingleNode("//location/lng").Text MsgBox lat & "," & lng End Sub
Доброе время суток Скорее всего текст адреса должен быть либо латинскими буквами либо в символьном шестнадцатеричном коде, как в запросе для адреса "Москва" (так сработало) [vba]
Доброе время суток Скорее всего текст адреса должен быть либо латинскими буквами либо в символьном шестнадцатеричном коде, как в запросе для адреса "Москва" (так сработало) [vba]
Макрос работает. Старайтесь следующий раз указывать где Вы взяли код - будет легче понять(по крайней мере мне). Просто этот макрос не работает с кириллицей. Тут есть несколько вариантов: вводить адреса в транслите(на латинице) Дописать код для перевода в латиницу Использовать другой код Смотрите вложение. Там 1-й код - Ваш но вставлен адрес на латинице. 2-й код - отсюда немного адаптированный под Ваш пример. [offtop]пока писал - anvg уже нашел туже причину [/offtop] Добавил: Можно добавить встроенную функцию для перевода текста в кодировку URL: [vba]
Макрос работает. Старайтесь следующий раз указывать где Вы взяли код - будет легче понять(по крайней мере мне). Просто этот макрос не работает с кириллицей. Тут есть несколько вариантов: вводить адреса в транслите(на латинице) Дописать код для перевода в латиницу Использовать другой код Смотрите вложение. Там 1-й код - Ваш но вставлен адрес на латинице. 2-й код - отсюда немного адаптированный под Ваш пример. [offtop]пока писал - anvg уже нашел туже причину [/offtop] Добавил: Можно добавить встроенную функцию для перевода текста в кодировку URL: [vba]
Всем огромное спасибо!!! Про шестнадцатеричный код, даже в голову мысль не приходила) Вот так всё отлично работает! [vba]
Код
Sub LatLong() Dim a, lat, lng, urladr As String a = InputBox("Место назначения (Город, адрес)", "Пункт", "") a = Replace(a, " ", "+") For i = 1 To Len(a) l = Mid(a, i, 1) Select Case AscW(l) Case Is > 4095: t = "%" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64) Case Is > 127: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64) Case 32: t = "%20" Case Else: t = l End Select b = b & t Next urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & b & "&sensor=false" Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.Load urladr Do While xmlDoc.readyState <> 4 DoEvents Loop lat = xmlDoc.SelectSingleNode("//location/lat").Text lng = xmlDoc.SelectSingleNode("//location/lng").Text MsgBox lat & ", " & lng End Sub
[/vba]
Всем огромное спасибо!!! Про шестнадцатеричный код, даже в голову мысль не приходила) Вот так всё отлично работает! [vba]
Код
Sub LatLong() Dim a, lat, lng, urladr As String a = InputBox("Место назначения (Город, адрес)", "Пункт", "") a = Replace(a, " ", "+") For i = 1 To Len(a) l = Mid(a, i, 1) Select Case AscW(l) Case Is > 4095: t = "%" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64) Case Is > 127: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64) Case 32: t = "%20" Case Else: t = l End Select b = b & t Next urladr = "http://maps.google.com/maps/api/geocode/xml?address=" & b & "&sensor=false" Set xmlDoc = CreateObject("Microsoft.XMLDOM") xmlDoc.Load urladr Do While xmlDoc.readyState <> 4 DoEvents Loop lat = xmlDoc.SelectSingleNode("//location/lat").Text lng = xmlDoc.SelectSingleNode("//location/lng").Text MsgBox lat & ", " & lng End Sub