住所から緯度・経度を取得するVBAを記述する
[Alt]+[F11]キー押下でVBエディタを開き、まず[Microsoft XML, v3.0]と[Microsoft Script Control 1.0]の参照設定を追加しておいてください。 続いて、左ペインから[Sheet1]をクリックし、以下のコードを入力します。
[リスト1]住所から緯度・経度を取得するVBA
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
'(3)地図を描く
RedrawMap
End Sub
Worksheet_BeforeDoubleClickという名前でプロシージャを定義すると、ダブルクリックのイベントが発生した際に実行するVBAを記述することができます。仮引数のTargetでダブルクリックしたセルを取得できます。仮引数のCancelはこの操作の結果(セルが選択された状態)をキャンセルするかどうかを指定します。
Byvalのない仮引数は参照渡しなので、値の変更が可能です。今回、ダブルクリックで住所を編集する必要はないので、最初にCancelにはTrueを設定して、セルの選択状態を解除しておきます。
(1)では、Targetに格納された住所をURLエンコードしたaddrを引数に指定してジオコーディングのリクエストを送信しています。 (2)では、レスポンスのXMLを解析して、緯度と経度を取り出しています。
(3)では、続いて地図をブラウザに描くユーザ定義関数RedrawMapを呼び出しています(後述)。
緯度・経度・ズーム値から地図を取得するVBAを記述する
ユーザ定義関数RedrawMapでは、Google Static Maps API を利用して、取得した緯度・経度とズーム値から地図の画像を取得します。
[リスト2]ユーザ定義関数RedrawMapのVBA
Sub RedrawMap()
Dim url As String
url = "http://maps.google.com/maps/api/staticmap?size=512x512&sensor=false¢er="
url = url & Sheet2.Range("latitude")
url = url & "," & Sheet2.Range("longitude")
url = url & "&zoom=" & Sheet2.Range("zoom")
Dim strType As String
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
512×512ピクセルの大きさで、中心座標(緯度,経度)をcenter引数、ズームレベルをzoom引数、地図の種類をmaptype引数に設定して、リクエストURLをウェブブラウザのNavigateメソッドの引数に指定することにより、地図を表示することができます。
ここまでできたらとりあえず、Sheet2のzoomには初期値として16ぐらいを入力しておき、Sheet1の住所の入ったセルをダブルクリックしてみて、地図が表示されたらまず成功です。
移動・ズームボタン・地図種別クリック時に地図を変更するVBAを記述する
クリック時に実行されるVBAを記述するために、Sheet1で[開発]タブの[デザインモード]をONの状態にして、各オブジェクトをダブルクリックします。 まず、btnNをダブルクリックして、北へ移動させる処理を記述します。
[リスト3]北へ移動させるVBA
Private Sub btnN_Click()
Sheet2.Range("latitude") = Sheet2.Range("latN")
RedrawMap
End Sub
予め、ワークシート関数で計算しておいた地図の上辺の緯度を、中心緯度に設定して地図を描きなおすだけです。
同様に、西、南、東へ移動させる処理を記述します。
[リスト4]西、南、東へ移動させるVBA
Private Sub btnW_Click()
Sheet2.Range("longitude") = Sheet2.Range("lngW")
RedrawMap
End Sub
Private Sub btnS_Click()
Sheet2.Range("latitude") = Sheet2.Range("latS")
RedrawMap
End Sub
Private Sub btnE_Click()
Sheet2.Range("longitude") = Sheet2.Range("lngE")
RedrawMap
End Sub
続いて、ズームボタン、地図種別をクリックした時のVBAを記述します。クリックした時点で、Sheet2のzoom、roadmap、satellite、terrain、hybridには変更した値が設定されますので、地図を書き直すだけです。
[リスト5]ズームボタン、地図種別をクリックした時のVBA
Private Sub SpinButton1_Change()
RedrawMap
End Sub
Private Sub obRoadmap_Click()
RedrawMap
End Sub
Private Sub obSatellite_Click()
RedrawMap
End Sub
Private Sub obTerrain_Click()
RedrawMap
End Sub
Private Sub obHybrid_Click()
RedrawMap
End Sub
最後に、Excelを開いた時にウェブブラウザが余計な動作をすることがあるので、これを止めるよう、ThisWorkbook内に以下のコードを追加しておきます。
[リスト6]Excel起動時にウェブブラウザの挙動を抑制するVBA
Private Sub Workbook_Open()
Sheet1.WebBrowser1.Stop
End Sub
これにて完成です。各ボタンをクリックして意図した動作になれば成功です。なお、移動は地図の1辺の半分ずつ動かすようになっています。もっと動かしたい場合は、Sheet2のmoveセルを調整してください。無闇にクリックして、先述した1日の制限1000件を超すと画像が表示されなくなり、次の日まで待つ羽目になるので注意してください。
まとめ
Googleマップはいかがでしたか。詳細な仕様は下記のURLにありますので、自分好みのカスタマイズをしたい方は、参考にしてみてください。
http://code.google.com/intl/ja/apis/maps/documentation/webservices/index.html
WINGSプロジェクト 遠藤 存著/山田祥寛監修
WINGS プロジェクトについて
テクニカル執筆プロジェクト(代表山田祥寛)。海外記事の翻訳から、主にWeb開発分野の書籍・雑誌/Web記事の執筆、講演等を幅広く手がける。2011年5月時点での登録メンバは35名で、現在も一緒に執筆をできる有志を募集中。