このブログに「Googleマップ 緯度経度 Excelへ」という検索キーワードからのアクセスがありました。おそらく、GoogleマップなどWeb地図で表示させた位置の緯度・経度を、選択・コピー＆ペーストといった手間なく転記したいというニーズでしょう。
私も業務アプリ作成の中で、デジカメ写真の位置情報や住所から変換（リバースジオコーディング）した位置情報を微調整する機能を作成したことがあります。そのときは、自前のWebサーバーにある程度の機能をJavaScriptで実装する方法としました。
いろいろな手法が考えられると思いますが、今回は緯度経度の取得のみに限定して最も手間のかからない方法で作成してみました。
（初出2015/6/21、最新情報で更新2017/12/16）
どのようにするか
Web地図上にマーカーを設置して、そのマーカーをドラッグ＆ドロップして…ていうのは開発側も利用側も手間がかかるので、単純に表示地図の中心座標を利用することにします。
GoogleマップがWeb地図として最もよく使われていますが、今回は以下の理由により地理院地図を利用します。
- 標準で中心に十字カーソルが表示されている。
- URLに位置情報が含まれ取得しやすい。
- 国土地理院が広告なしで無償で公開している地図だから。
緯度経度を取得するには，ExcelとInternet Explorerを連携させ、位置情報の受け渡しをします。
ある程度の緯度・経度がわかっている場合はそれを用い、何もない場合は既定の位置で地理院地図を開きます。地図の中心の緯度・経度はURLから取得することにします。
マクロの作成
参照設定
Internet Explorerをコントロールしたいので、VBEの参照設定で、’Microsoft Internet Controls’ をチェックします。
コード
コードの解説は以下の緑色のコメント内に記載しています。
特徴は何でも完璧に動かそうとせず，エラー処理に任せているところでしょうか。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Option Explicit Sub getCenter_from_CyberJapan() Dim IE As InternetExplorer Dim Lat As Double, Lon As Double, Zoom As Integer Dim URL As String, URLs As Variant Dim Rng As Range Set Rng = ActiveCell '途中でずれないように最初のアクティブセルを取得。 'ActiveCellとその右のセルから起点にする緯度・経度を取得 On Error GoTo Err_Not_a_number '数値以外の場合はエラー処理へ Lat = Rng.Value Lon = Rng.Offset(0, 1).Value On Error GoTo 0 'エラー処理終了 'どちらかが空欄（または0）の場合、東京を起点にする If Lat * Lon = 0 Then Lat = 35.68: Lon = 139.767 '初期ズームレベル Zoom = 16 '初期表示URL URL = "http://maps.gsi.go.jp/#" & _ CStr(Zoom) & "/" & CStr(Lat) & "/" & CStr(Lon) 'IEのオブジェクトを生成 Set IE = CreateObject("InternetExplorer.Application") With IE .Navigate URL '初期表示URLにアクセス .StatusBar = False 'ステータスバーを非表示 .AddressBar = False 'アドレスバーを非表示 .MenuBar = False 'メニューバーを非表示 On Error GoTo Err_CloseIE 'IEが閉じられた場合はエラー処理 Do While .Busy Or .ReadyState < READYSTATE_COMPLETE 'IEの表示待ち DoEvents Loop On Error GoTo 0 'エラー処理終了 .Visible = True 'IEを表示 On Error GoTo Err_Complete 'IEを閉じた場合にエラー処理により抜ける Do URLs = Split(.LocationURL, "/") 'URLをスラッシュで分割 Rng.Value = URLs(4) '分割した文字列の5番目が緯度 Rng.Offset(0, 1) = URLs(5) '分割した文字列の6番目が経度 DoEvents Loop 'エラー処理で抜けるまで繰り返す On Error GoTo 0 'IEを表示 End With Exit Sub Err_Not_a_number: 'アクティブセルとその右のセルが数値でない Call MsgBox("緯度・経度または空欄のセルを選択して下さい。", vbCritical + vbOKOnly) Exit Sub Err_CloseIE: '表示待ちの間にIEが閉じられた Call MsgBox("Internet Explorerが閉じられたため終了します。", vbExclamation + vbOKOnly) Exit Sub Err_Complete: '座標セットが終わりIEを閉じた場合 '何もせずプロシージャを終了する End Sub |
48~49行目では，スラッシュで分割したものをSplit関数で配列に入れていますが，配列は0から始まるので，下図のように緯度を4，経度を5で指定します。
動作確認
動作確認すると，以下のようになります。マクロの実行は，別途ボタンを作るか，コンテキストメニューかリボンにつけるなどしてください。面倒であればショートカットキーを割り当てるだけでもいいと思います。
ダウンロード
この記事の手順ので作成できますのでチャレンジしてみて下さい。面倒な方のために以下よりサンプルファイルをダウンロード購入できます。
この下にGumroadのウィジェットを表示しています。表示されていない場合は企業・学校などのフィルタリングと思われますので、別な接続でお試し下さい。