Excel VBAでInternetExploreを操作する ～例）リストの緯度経度をGoogle Mapで開く

「氏名（会社名）」「住所」「Longitude」「Latitude」「縮尺」のリストを作り、ボタン押下でその緯度経度の地図を、次々とフォームやブラウザで表示するマクロの紹介です。
How to open Google Map by Excel VBA (Open maps from latitude and longitude table).

Map表示（Microsoft Web Browser）フォームの作成

新規フォームを作成し、ツールボックスの空欄部を右クリック、「その他のコントロール」から「Microsoft Web Browser」を選択し、フォームに貼り付けます。



Excel VBAとウェブブラウザを連携させる方法としては、Web Browserをフォームに配置する今回の例の他に、

(a) Web Browserをワークシートに配置する
(b) Internet Exploreを起動・操作する
(c) Chromeを起動・操作する

上記３つの方法があります。

(a)はExcel/Windowsのバージョンによって操作できないバグがあるので、自分のＰＣで正常に動作しても配布・公開する際は注意した方がいいです。(b)はベストの方法です。今回フォームに配置したのは「別アプリを起動する際の、画面の煩雑さを無くす」ためで、フォーム内の配置ではInternetExplore「7」という古いバージョンとして動作してしまうので、ベストな方法ではありません（サイトによってはエラーメッセージが出て、回避策はレジストリをいじるしかありません）。(c)も可能ですが、VBAで行うのは不便なので、Selenium等の専用ツールを使う方をおすすめします。ExcelとIE、どちらもMicrosoftということで、コードが簡潔になるのです。

リストのカーソル移動用コード

リストのＢ列にカーソル「→」を記入し、ボタン操作で移動できるようにします。Excel VBAでは、ボタンに登録したり、ユーザー定義関数として使用するSub/FunctionはPublicで宣言し、その他はPrivateとすると分かりやすいです。

以下のコードは全てひとつの標準モジュールに記載します。表のレイアウトは使う人により様々だと思いますので、列・行関係のコードを適当に書き換えて利用してください。

'「進む」ボタンに登録
Public Sub move_next()
    move_list 1
End Sub

'「戻る」ボタンに登録
Public Sub move_prev()
    move_list -1
End Sub

'「拡大」ボタンに登録
Public Sub up_scale()
    change_scale 1
End Sub

'「縮小」ボタンに登録
Public Sub down_scale()
    change_scale -1
End Sub

'move_next/move_prevの親関数。「→」を検索し、表をはみ出さない場合は移動して、mapを再読み込みします。
Private Function move_list(move_value)
    Dim my_cursor As Range
    Set my_cursor = search_cursor.Offset(move_value, 0)
   
    If Not IsEmpty(my_cursor.Offset(0, 1)) And my_cursor.Row > 1 Then
        search_cursor.Value = ""
        my_cursor.Value = "→"
        get_map
    End If
End Function

'up_scale/down_scaleの親関数。表中の縮尺を増減して、再描写しています。
'Google Mapで実用的な縮尺に収まるように制限を加えています。
Private Function change_scale(change_value)
    Dim my_cursor As Range
    Set my_cursor = search_cursor.Offset(0, 5)
   
    If (change_value > 0 And my_cursor.Value < 18) Or (change_value < 0 And my_cursor.Value > 8) Then
        my_cursor.Value = my_cursor.Value + change_value
        get_map
    End If
End Function

’「→」カーソルを検索するサブ関数です。もしカーソルが無ければ、先頭に作ります。
Private Function search_cursor() As Range
    Dim sheet_List As Worksheet
    Set sheet_List = ThisWorkbook.Worksheets("List")
       
    Dim range_finder As Range
    Set range_finder = sheet_List.Columns(2).Find(What:="→", LookAt:=xlWhole)
   
    If range_finder Is Nothing Then
        sheet_List.Range("B2") = "→"
        Set search_cursor = sheet_List.Range("B2")
    Else
        Set search_cursor = range_finder
    End If
End Function

地図表示コード

地図表示コードも上記と同じ標準モジュールに記載します。Google MapはURLに緯度経度を指定して開くことができるので、Excel表内の数値でURLを作成し、WebBrowserで開いています。

参照設定で「Microsoft Internet Controls」を選択します。Internet Controlsと言っても中身はIEであり、後述するIEを別途起動する場合も、殆ど同じコードで動きます。

current_lon = my_cursor.Offset(0, 3)などは、表中のカーソル「→」からいくつずれたところに緯度などの値があるかによって変わります。項目名をFindで検索する関数を介せば、数値でなく項目名でアクセスすることも可能ですが、今回は複雑な表でないので固定値としました。

Public Function get_map()
       
    Dim my_browser As WebBrowser
    Set my_browser = mapForm.WebBrowser1 '作ったフォームとWebBrowserを指定
   
    Dim my_cursor As Range
    Set my_cursor = search_cursor
         
    Dim current_name, current_address, current_lon, current_lat, current_scale
    current_name = my_cursor.Offset(0, 1)
    current_address = my_cursor.Offset(0, 2)
    current_lon = my_cursor.Offset(0, 3)
    current_lat = my_cursor.Offset(0, 4)
    current_scale = my_cursor.Offset(0, 5)
         
    If mapForm.Visible = False Then
        mapForm.Show vbModeless
    End If
         
    'Google Map
    my_browser.navigate "https://www.google.co.jp/maps/@" & current_lat & _
                       "," & current_lon & "," & current_scale & "z"
                               
    wait_browser_ready my_browser
   
    mapForm.infoLabel.Caption = current_name & ", " & current_address
   
    Set my_browser = Nothing
   
End Function

'wait browser ready
Private Function wait_browser_ready(my_browser As WebBrowser)
    Do While my_browser.Busy = True Or my_browser.readyState <> 4
        DoEvents
    Loop
End Function

InternetExploreで開く場合

同じポイントに対し、Google Map、国土地理院、国土地理院（衛星写真）を３タブ開きます。上記との違いは、my_browser As New 「InternetExplorer」と宣言していることです。縮尺はそれぞれ単位が異なるので、適当な固定値としました。

Public Function get_map2()
       
    Dim my_browser As New InternetExplorer
    my_browser.Visible = True
   
    Dim my_cursor As Range
    Set my_cursor = search_cursor
         
    Dim current_lon, current_lat
    current_lon = my_cursor.Offset(0, 3)
    current_lat = my_cursor.Offset(0, 4)   
         
    'Google Map
    my_browser.navigate "https://www.google.co.jp/maps/@" & current_lat & _
                        "," & current_lon & ",100m/data=!3m1!1e3"
                                                 
    '国土地理院
    '通常地図
    my_browser.Navigate2 "http://maps.gsi.go.jp/?vs=c1#16" & _
                        "/" & current_lat & _
                        "/" & current_lon & _
                        "/&base=std&ls=std&disp=1&vs=c1j0h0k0l0u0t0z0r0s0f1", _
                        2048
                       
    '衛星写真
    my_browser.Navigate2 "https://maps.gsi.go.jp/#16" & _
                         "/" & current_lat & _
                         "/" & current_lon & _
                         "/&base=std&ls=std%7Cseamlessphoto&blend=0&disp=11&lcd=seamlessphoto&vs=c1j0h0k0l0u0t0z0r0s0f1", _
                         2048
   
    wait_browser_ready my_browser
       
    Set my_browser = Nothing
   
End Function