http://news.mynavi.jp/articles/2012/04/24/excelvba/index.html
このページのものを参考にして、地図を表示させ、マーカーを表示させるところまではうまくいきましたが、マーカーが一つしか表示されず、2行目までの住所を同時に表示させることができません。
どなたか、回答よろしくお願いします。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim xhr As New MSXML2.XMLHTTP
Dim tmp As New MSXML2.DOMDocument
Dim geo As MSXML2.IXMLDOMNodeList
Dim loc As MSXML2.IXMLDOMNode
Dim addr As String
Dim url As String
Dim js As Object
Dim coordtmp() As String
Dim coord As String
Set js = CreateObject("ScriptControl")
js.Language = "JScript"
addr = js.CodeObject.encodeURIComponent(Target)
If addr = "undefined" Then Set js = Nothing: Exit Sub
Set js = Nothing
'(1)URLエンコードした住所から、ジオコーディングのリクエストを送信する
url = "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & addr
xhr.Open "POST", url, False
xhr.send
If xhr.StatusText <> "OK" Then Exit Sub
'(2)レスポンスから緯度・経度を取り出し、Sheet2の該当セルに設定する
tmp.LoadXML (xhr.responseText)
Set geo = tmp.getElementsByTagName("geometry")
Set loc = geo(0).FirstChild
Set xhr = Nothing
Sheet2.Range("latitude") = loc.FirstChild.Text
Sheet2.Range("longitude") = loc.LastChild.Text
Sheet2.Range("targetname") = Target.Offset(0, -2).Value '追加
'(3)地図を描く
RedrawMap
End Sub
Sub RedrawMap()
Dim url As String
Dim s As String
Dim strType As String
s = Sheet2.Range("latitude") & "," & Sheet2.Range("longitude")
url = "http://maps.google.com/maps/api/staticmap?size=512x512&sensor=false"
url = url & "¢er=" & s
url = url & "&zoom=" & Sheet2.Range("zoom")
url = url & "&markers=color:blue%7Clabel:" & Sheet2.Range("targetname")
url = url & "%7C" & s
If Sheet2.Range("roadmap") Then strType = "roadmap"
If Sheet2.Range("satellite") Then strType = "satellite"
If Sheet2.Range("terrain") Then strType = "terrain"
If Sheet2.Range("hybrid") Then strType = "hybrid"
url = url & "&maptype=" & strType
Sheet1.WebBrowser1.Navigate url
End Sub
