/*Google AdSense自動広告*/

2018年9月19日水曜日

Excel VBA 緯度経度リストに、Google Map(衛星写真)のハイパーリンクを作成する

ある緯度経度の場所をGoogle Mapで見たい場合、Mapの検索ボックスに緯度経度をコンマ区切りで入力するか、Google検索で直接入力すると表示できます。
How to get Google Map link from Latitude and Longitude. Parse Google Map URL.

Excelで緯度経度の表がある場合は、ブラウザへのコピペよりも、セル内のハイパーリンクをワンクリックすることで直接開けば作業がはかどります。今回は、緯度経度の表を作った後、実行すると右端にハイパーリンクが作成されるマクロを作成しました。

このコードの肝となるのが、セルへのHyperlinks.Addと、緯度経度に対応するURLの生成です。

通常のGoogle Mapは、緯度、経度、縮尺をコンマで区切った、以下のようなURLを直接ブラウザに入力して開くことが出来ます。縮尺はメートルでなくインデックス値で、大きいほど拡大されます。
https://www.google.co.jp/maps/@38.4371617,140.3171753,12.02z

衛星写真だと、以下のように縮尺と後ろのオプション設定が変わってきます。
https://www.google.co.jp/maps/@38.4421977,140.3493863,2317m/data=!3m1!1e3

縮尺はメートル表記、「data=!3m1!1e3」が衛星写真を表示するオプションです。細かい数値の意味は分かりませんが、実際に色々と表示を変えてみて、URLをコピペして利用すると良いでしょう。

ただしこれでは、ポイントを示す赤いピンが表示されません。ピンもURLの中に組み込むことで表示できますが、何故かピンの表記は度分秒、その他は小数形式になることに注意です。

https://www.google.co.jp/maps/place/38%C2%B026'31.9%22N+140%C2%B020'57.8%22E/@38.4422019,140.3471976,459m/data=!3m2!1e3!4b1!4m5!3m4!1s0x0:0x0!8m2!3d38.4421977!4d140.3493863

「38%C2%B026'31.9%22N+140%C2%B020'57.8%22E」は、ブラウザ上では「38°26'31.9"N+140°20'57.8"E」と表示されます。メモ帳やExcel上では文字コードの関係でこのような表記となりますが、問題ありません。

緯度経度からURLを生成し、ハイパーリンクとして設定することで、ワンクリックでその場所の衛星地図とピンを表示することができるのです。

【表に一括入力するコード】(標準モジュールに記載し、ボタンに登録するか、「開発」タブ→マクロ→実行します)
※緯度経度は度分秒形式(37°23'35")と小数形式(37.34503)があります。相互に変換が可能なので、どちらを使ってもいいのですが、今回は小数形式で動作するようにしました。

Public Sub make_link()
    
    '先頭のカーソルを設定し、B列が空白に当たるまで上から順に処理します。
    Dim rCursor As Range
    Set rCursor = ThisWorkbook.Worksheets("list").Range("B2")
    
    Do While Not IsEmpty(rCursor)
    
        Dim name, lat, lon
        Dim lat_h, lat_m, lat_s, lon_h, lon_m, lon_s
        
        name = rCursor.Value
        lat = rCursor.Offset(0, 1).Value
        lon = rCursor.Offset(0, 2).Value
        
        lat_h = Int(lat)
        lat_m = Int((lat - lat_h) * 60)
        lat_s = WorksheetFunction.Round((lat - lat_h - (lat_m / 60)) * 3600, 2)
        
        lon_h = Int(lon)
        lon_m = Int((lon - lon_h) * 60)
        lon_s = WorksheetFunction.Round((lon - lon_h - (lon_m / 60)) * 3600, 2)
        
        rCursor.Offset(0, 3).Hyperlinks.Add rCursor.Offset(0, 3), "https://www.google.com/maps/place/" & _
            lat_h & "%C2%B0" & lat_m & "'" & lat_s & _
            "%22N+" & lon_h & "%C2%B0" & lon_m & "'" & lon_s & _
            "%22E/@" & lat & "," & lon & ",150m/data=!3m1!1e3!4m5!3m4!1s0x0:0x0!8m2!3d" & lat & "!4d" & lon
               
        Set rCursor = rCursor.Offset(1, 0)
        
    Loop
    
End Sub

0 件のコメント:

コメントを投稿