備忘録:EXCELでGoogleMapを表示する

EXCEL+MySQLで独自業務システムを運用しているお客様で、顧客マスターでGoogleMAPを表示する仕組みを追加致しました。

顧客マスターの表示画面にボタンを張り付け、顧客マスターの商号、住所をGoogleMAPに受け渡す事でEXCEL上にGoogleMAPを表示する処理です。

googleMap

MAPを表示するシートに以下のVBAコードを張り付けることで実現します。
MAP-infoというシートに地図データを一旦保管し、その後、GoogleMAPを呼び出すURLを
作成します。EXCEL上にIEの窓を一つ作り、その窓にGoogleMAPを表示する処理を行います。

※多くの方々が公開されていますコードを参考にさせて頂きました。
 ありがとうございました。
 参考サイト:http://news.mynavi.jp/articles/2012/04/24/excelvba/

Private Sub Worksheet_Activate()
 Target = Range("b2")
 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
 url = "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & addr
url = "http://maps.google.com/maps/api/geocode/xml?sensor=false&address=" & addr & "&key=" & API-Key
' API KeyはGooge Cloud Platform の「APIとサービス」で取得

 xhr.Open "POST", url, False
 xhr.send
 If xhr.StatusText <> "OK" Then Exit Sub
 tmp.LoadXML (xhr.responseText)
 Set geo = tmp.getElementsByTagName("geometry")
 Set loc = geo(0).FirstChild
 Set xhr = Nothing

 Worksheets("MAP-info").Range("b1") = loc.FirstChild.Text
 Worksheets("MAP-info").Range("b2") = loc.LastChild.Text

 '地図を表示
 drawMap

End Sub

Sub drawMap()
 Dim myAddressCoodinatePosition As String ' マーカーを付ける場所
 Dim layer As String

 Dim url As String
 url = "http://maps.google.com/maps/api/staticmap?size=512x512&sensor=false&center="
 url = url & Worksheets("MAP-info").Range("b1")
 url = url & "," & Worksheets("MAP-info").Range("b2")
 url = url & "&zoom=" & Worksheets("MAP-info").Range("b3")

 Dim strType As String
 If Worksheets("MAP-info").Range("b4") Then strType = "roadmap"
 If Worksheets("MAP-info").Range("b5") Then strType = "satellite"
 If Worksheets("MAP-info").Range("b6") Then strType = "terrain"
 If Worksheets("MAP-info").Range("b7") Then strType = "hybrid"

 myAddressCoodinatePosition = Worksheets("MAP-info").Range("b1") & "," & Worksheets("MAP-info").Range("b2")

 layer = "c"
 url = url & "&maptype=" & strType & "&markers=" &  myAddressCoodinatePosition
 Worksheets("Map").WebBrowser1.Navigate url
End Sub