Go to Qiita Advent Calendar 2024 Top
LoginSignup
6
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

@Spooky_Maskman(Spooky Maskman)

VBAを愛するあなたへ『Google Maps APIで位置情報と航空写真を取得する方法』

Last updated at Posted at 2019-07-24

はじめに

今回の記事は、以前私が書いた記事『PythonでGoogle Maps APIを利用して位置情報と航空写真を取得する』の続編になります。
先日、上記の記事を読んだ会社の同僚から、「Excel VBA でも同じことができないか？」という質問を受けました。
この質問に対し、私は「できますよ」とお答えしたのですが、具体的な方法までは知らなかったので、良い機会だと思い、VBA で上記の処理を再現することにしました。

目次

  • 環境
  • 事前準備
  • フォーマットの作成
  • 位置情報の取得
  • 航空写真の取得
  • 参考情報
  • 最後に

環境

本記事における実装環境は以下となっています。

  • Windows 10 Home
  • Microsoft Office 2016 - Excel

事前準備

以下のサイトより、GoogleのAPIキーを取得しておきます。
Google Maps Platform：https://developers.google.com/maps/web/
詳しい取得方法については参考情報の記事をご参照下さい。

それから、今回の記事で緯度経度や航空写真を取得したい地名や住所も用意しておきます。
今回は以下の5つの地点について、緯度経度の情報や航空写真を取得していきたいと思います。

  • 平安神宮
  • 東京タワー
  • 大阪城
  • 原爆ドーム
  • 東京都千代田区永田町1丁目7-1（国会議事堂の住所）

次章では、これら5つを既に記載した状態のフォーマットの写真を載せています。

フォーマットの作成

今回作成したフォーマットが以下の写真のものになります。

FORMAT.PNG

Google Maps API は無料枠が各サービスによって異なるので、マクロを実行するボタンの横に、無料枠分に相当するRequest数を赤字で※マークを付けて記載しています。
位置情報を取得する場合は4万件、航空写真を取得する場合は10万件までが無料枠となります（2019年7月時点）。
こちらについては、参考情報に詳しく説明がされているサイトを紹介させていただいておりますので、そちらをご確認下さい。

フォーマット上では、以下の8項目をパラメータとして記載しており、次章以降で紹介するマクロでは該当のセル番地を指定する形で、各パラメータ項目を使用しています。

  • B1：ダウンロードした航空写真を保存するアウトプットフォルダ
  • B2：航空写真の保存時の出力形式（png・jpegなど）
  • B3：事前準備で取得したAPIキー
  • B4：航空写真の地図形式（hybrid・satelliteなど）
  • B5：取得する航空写真の画素数
  • B6：取得する航空写真の縮尺度合い
  • A7~：各地名や住所に対し一意となるIDであり、出力した航空写真のファイル名となる
  • B7~：位置情報や航空写真を取得したい地点の名称や住所

また、私の作成したフォーマットでは、航空写真の保存時の出力形式と航空写真の地図形式については、『データの入力規則』より、『入力値の種類』で「リスト」を選択した上で、以下の写真のようなドロップダウンリストとなるように『元の値』にカンマ区切りで項目を列挙していきます。

list.png

前回の記事の再掲となりますが、ここで設定する航空写真の地図形式は以下の4種類となっています。

  • roadmap: 道路や建物などが表示されるGoogle Mapにおけるデフォルトのロードマップで、maptypeを指定しない場合はこのmaptypeで出力される
  • satellite: Google Earthで公開されている衛星画像
  • hybrid: roadmapとsateliteを複合した地図
  • terrain: roadmapから建物などの情報を除いた地形情報のみの地図

基本的にパラメータとして設定している項目に関しては、前回の記事に説明が記載されているので、そちらをご参照下さい。

位置情報の取得

それでは早速位置情報を取得していきましょう。
前回の記事では JSON 形式でジオコードを呼び出していましたが、今回は XML 形式で呼び出すようにしています。
手始めに以下のURLでどのような情報が取得できるか見てみましょう。
https://maps.googleapis.com/maps/api/geocode/xml?address=平安神宮&key=【APIキー】

すると、以下のように XML で結果が返ってくると思います。

XML
  <?xml version="1.0" encoding="ISO-8859-1"?>
- <GeocodeResponse>
     <status>OK</status>
   - <result>
        <type>establishment</type>
        <type>place_of_worship</type>
        <type>point_of_interest</type>
        <formatted_address>日本、〒606-8341 京都府京都市左京区岡崎西天王町</formatted_address>
      - <address_component>
           <long_name>岡崎西天王町</long_name>
           <short_name>岡崎西天王町</short_name>
           <type>political</type>
           <type>sublocality</type>
           <type>sublocality_level_2</type>
        </address_component>
      - <address_component>
           <long_name>左京区</long_name>
           <short_name>左京区</short_name>
           <type>political</type>
           <type>sublocality</type>
           <type>sublocality_level_1</type>
        </address_component>
      - <address_component>
           <long_name>京都市</long_name>
           <short_name>京都市</short_name>
           <type>locality</type>
           <type>political</type>
        </address_component>
      - <address_component>
           <long_name>京都府</long_name>
           <short_name>京都府</short_name>
           <type>administrative_area_level_1</type>
           <type>political</type>
        </address_component>
      - <address_component>
           <long_name>日本</long_name>
           <short_name>JP</short_name>
           <type>country</type>
           <type>political</type>
        </address_component>
      - <address_component>
           <long_name>606-8341</long_name>
           <short_name>606-8341</short_name>
           <type>postal_code</type>
        </address_component>
      - <geometry>
         - <location>
              <lat>35.0159823</lat>
              <lng>135.7824263</lng>
           </location>
           <location_type>GEOMETRIC_CENTER</location_type>
         - <viewport>
            - <southwest>
                 <lat>35.0146333</lat>
                 <lng>135.7810773</lng>
              </southwest>
            - <northeast>
                 <lat>35.0173313</lat>
                 <lng>135.7837753</lng>
              </northeast>
           </viewport>
        </geometry>
        <place_id>ChIJjch8GOUIAWART0WX2JLZvnU</place_id>
      - <plus_code>
           <global_code>8Q7Q2Q8J+9X</global_code>
           <compound_code>2Q8J+9X 日本、京都府 京都市</compound_code>
        </plus_code>
     </result>
  </GeocodeResponse>

今回作成するマクロでは、まず上記の XML の30行目にある以下の箇所より都道府県の情報を取得していきます。

      - <address_component>
           <long_name>京都府</long_name> <---- 情報を抜き出したい箇所
           <short_name>京都府</short_name>
           <type>administrative_area_level_1</type>
           <type>political</type>
        </address_component>

次に、上記の XML の48行目と49行目にある以下の箇所から、任意の地点の緯度と経度の情報を取得していきます。

      - <geometry>
         - <location>
              <lat>35.0159823</lat> <---- 情報を抜き出したい箇所
              <lng>135.7824263</lng> <---- 情報を抜き出したい箇所
           </location>

上記の XML よりどこの情報を取得したいのかを整理した上で、以下のマクロを作成し、それぞれの地名や住所に対し、都道府県・緯度・経度の情報を取得していきます。

GeoCoding
'-- ==========================
'-- Create date:YYY/MM/DD
'-- Author:MR
'-- Description:地名や住所を元に、ジオコード処理によって都道府県・緯度・経度の情報を取得する
'--             その際、GoogleAPIキーは変数として設定する
'-- ==========================


Public Sub GeoCoding()

Dim RowNo   As Long
Dim i       As Long
    
'最終行を取得
RowNo = Cells(8, 2).End(xlDown).Row

'最終行までループ処理する
For i = 8 To RowNo
    '住所が入力されていたらジオコード処理を実行
    If ActiveSheet.Cells(i, 2).Value <> "" Then
    
        'ジオコーディングの結果を配列に格納（都道府県、緯度、経度）
        strData = Split(GeoCoding_zip(ActiveSheet.Cells(i, 2).Value), ",")
    
        ActiveSheet.Cells(i, 3).Value = strData(0)      '都道府県
        ActiveSheet.Cells(i, 4).Value = Val(strData(1)) '緯度
        ActiveSheet.Cells(i, 5).Value = Val(strData(2)) '経度
        
    End If
Next i

End Sub

Function GeoCoding_zip(ByVal adress As String) As String
'GoogleMaps API XML形式でジオコードを取得
'戻り値：都道府県(long_name)

Dim HttpReq         As MSXML2.XMLHTTP60
Dim DomDoc          As MSXML2.DOMDocument60
Dim strGeocode      As String
Dim xmlresult       As IXMLDOMNode
Dim xmlLat          As IXMLDOMNode
Dim xmlLng          As IXMLDOMNode
Dim xmlZip          As IXMLDOMNode
Dim xmlStatus       As IXMLDOMNode
Dim URL             As String
Dim KEY             As String
KEY = ActiveSheet.Cells(3, 2).Value
Dim wCount          As Long

 
'Google Maps Geocoding API
URL = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Encode_Uni2UTF(adress) & "&key=" & Encode_Uni2UTF(KEY)

'XMLHTTPオブジェクトをセット
Set HttpReq = New MSXML2.XMLHTTP60

With HttpReq
    .Open "GET", URL, varAsync:=False           '非同期モードで通信を開始
    .send                                       'リクエストを送信
    If .Status <> 200 Then Exit Function        'リクエストが成功しなかったら終了
    Set DomDoc = New MSXML2.DOMDocument60
End With

'XMLから情報を抽出する
With DomDoc
    
    'XMLドキュメントを読み込む
    .LoadXML (HttpReq.responseText)
    
    'resultの件数をカウントする
    Set xmlresult = .SelectSingleNode("//GeocodeResponse")
    wCount = 0
    For Each xmlresult In xmlresult.ChildNodes
        If xmlresult.nodeName = "result" Then
            wCount = wCount + 1
        End If
    Next
    
    '複数の結果が返ってきた場合
    If wCount >= 2 Then
        strGeocode = "住所を確認して下さい。結果が複数あります。"
        GoSub End_GeoCoding
    End If
    
    'status要素を取得
    Set xmlStatus = .SelectSingleNode("//GeocodeResponse/status")
    
    'ステータスの状態をチェック
    Select Case xmlStatus.Text
    
        'ジオコード成功の場合
        Case "OK"
        
            '郵便番号を取得
            Set xmlresult = .SelectSingleNode("//GeocodeResponse/result")
            For Each xmlresult In xmlresult.ChildNodes
                If xmlresult.nodeName = "address_component" Then
                    '3番目の子要素（type）がadministrative_area_level_1かチェック
                    If xmlresult.ChildNodes(2).Text = "administrative_area_level_1" Then
                        'long_nameを取得
                        strGeocode = xmlresult.ChildNodes(0).Text
                    End If
                End If
            Next
            
            'lat要素（緯度）を取得
            Set xmlLat = .SelectSingleNode("//GeocodeResponse/result/geometry/location/lat")
            strGeocode = strGeocode & "," & xmlLat.Text
             
            'lng要素（経度）を取得
            Set xmlLng = .SelectSingleNode("//GeocodeResponse/result/geometry/location/lng")
            strGeocode = strGeocode & "," & xmlLng.Text
        
        '以下ステータスがOKでは無く問題があった場合
        Case "ZERO_RESULTS"
            strGeocode = "住所から緯度経度を出力出来ませんでした。"
        
        Case "OVER_QUERY_LIMIT"
            strGeocode = "クエリ数が割り当て量を超えています。"
        
        Case "REQUEST_DENIED"
            strGeocode = "リクエストが拒否されました。"
        
        Case "INVALID_REQUEST"
            strGeocode = "照会条件（address、components、latlngのいずれか）がありません。"
        
        Case "UNKNOWN_ERROR"
            strGeocode = "サーバーエラーでリクエストが処理できませんでした。"
    
    End Select
        
    
End_GeoCoding:
    
    '結果を返す
    GeoCoding_zip = strGeocode
    
End With

Set HttpReq = Nothing
Set DomDoc = Nothing
    
End Function

'文字列をUTF-8でエンコードする
Function Encode_Uni2UTF(ByRef strUni As String)
Dim buf As Variant
Dim tbuf As Variant
Dim n As Variant
Const CSET = "UTF-8"
Dim ADOstrm As Object 'ADODB.Stream

    On Error GoTo ErrHandler
    
    Set ADOstrm = CreateObject("ADODB.Stream")  'New ADODB.Stream
    ADOstrm.Open
    ADOstrm.Type = adTypeText
    ADOstrm.Charset = CSET
    ADOstrm.WriteText strUni
    ADOstrm.Position = 0
    ADOstrm.Type = adTypeBinary
    ADOstrm.Position = 3
    buf = ADOstrm.Read()
    ADOstrm.Close
    
    Set ADOstrm = Nothing
  
    For Each n In buf
       tbuf = tbuf & "%" & Hex(n)
    Next
    
    Encode_Uni2UTF = tbuf
    
    Exit Function
    
ErrHandler:
    If ADOstrm Is Nothing = False Then ADOstrm.Close
    Set ADOstrm = Nothing
End Function

上記のマクロを作成する上で参考としたサイトを、以下の参考情報のところで挙げておりますので，そちらもご参照下さい。
今回私が作成したフォーマットでは、『開発タブ』より『挿入』から『ボタン（フォームコントロール）』を選択することで、フォーマット上で GeoCoding のボタンを押すだけで、マクロが走るようにしています。
上手くマクロが回れば、以下の写真のような結果になっているはずです。

image.png

航空写真の取得

上記で各地名や住所に対し、緯度と経度の情報を取得できました。
次は、その情報を元に、各地名や住所の航空写真を取得していきます。

今回は、以下のマクロを作成して、各地名や住所の航空写真を、上記で取得した緯度と経度の情報を元にダウンロードし、指定したアウトプットフォルダへ、ファイル名が ID となるように指定した出力形式で保存していきます。

GetImage
'-- ==========================
'-- Create date:YYY/MM/DD
'-- Author:MR
'-- Description:URLリンク先の画像を指定の画像形式で保存する
'--             その際、GoogleAPIキーは変数として設定する
'--             画像の保存先はフルパスで設定する
'-- ==========================


Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
   (ByVal pCaller    As Long, _
    ByVal szURL      As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB     As Long) As Long
    

Public Sub GetImage()

Dim RowNo   As Long
Dim i       As Long
Dim DLValue As Long
    
'最終行を取得
RowNo = Cells(8, 1).End(xlDown).Row

'最終行までループ処理する
For i = 8 To RowNo    'フォーマット上8行目から組がスタートするので8行目からループ
    '住所が入力されていたらジオコード処理を実行
    If ActiveSheet.Cells(i, 1).Value <> "" Then
    
        'ジオコーディングの結果を配列に格納（ID、緯度、経度）
        DLValue = GetImage_zip(ActiveSheet.Cells(i, 1).Value, ActiveSheet.Cells(i, 4).Value, ActiveSheet.Cells(i, 5).Value)
        
    End If
Next i

End Sub


Function GetImage_zip(ByVal ID As String, ByVal Lat As String, ByVal Lng As String) As Long
'Google Maps API で航空写真を取得

Dim ImageURL       As String
Dim ImageName      As String
Dim FilePath       As String
Dim OutputPath     As String
OutputPath = ActiveSheet.Cells(1, 2).Value    '画像の保存先を指定
Dim Extension      As String
Extension = ActiveSheet.Cells(2, 2).Value     '画像の出力形式を指定
Dim KEY            As String
KEY = ActiveSheet.Cells(3, 2).Value
Dim MapType        As String
MapType = ActiveSheet.Cells(4, 2).Value
Dim Pixel          As String
Pixel = ActiveSheet.Cells(5, 2).Value
Dim MapZoom        As String
MapZoom = ActiveSheet.Cells(6, 2).Value
Dim Image          As Long


    '画像URLを指定
    ImageURL = "https://maps.googleapis.com/maps/api/staticmap?center=" & Encode_Uni2UTF(Lat) & "," & Encode_Uni2UTF(Lng) & "&maptype=" & Encode_Uni2UTF(MapType) & "&size=" & Encode_Uni2UTF(Pixel) & "&sensor=false&zoom=" & Encode_Uni2UTF(MapZoom) & "&markers=" & Encode_Uni2UTF(Lat) & "," & Encode_Uni2UTF(Lng) & "&key=" & Encode_Uni2UTF(KEY)

    '保存時の画像名を指定
    ImageName = ID

    '画像の保存先を、画像名や拡張子を含めたフルパスで指定
    FilePath = OutputPath & "\" & ImageName & "." & Extension

    '変数FilePathに代入したパスが存在しているか調べる、存在した場合はなにも処理しない
    If Dir(FilePath) <> "" Then

    '変数FilePathがない場合
    Else

    '画像をダウンロードする、ImageUrlは画像URL、FilePathは保存先、成功すると0を返す
    Image = URLDownloadToFile(0, ImageURL, FilePath, 0, 0)
       
    End If
 
End_GetImage:
    
    '結果を返す
    GetImage_zip = Image
    
End Function



'文字列をUTF-8でエンコードする
Function Encode_Uni2UTF(ByRef strUni As String)
Dim buf As Variant
Dim tbuf As Variant
Dim n As Variant
Const CSET = "UTF-8"
Dim ADOstrm As Object 'ADODB.Stream

    On Error GoTo ErrHandler
    
    Set ADOstrm = CreateObject("ADODB.Stream")  'New ADODB.Stream
    ADOstrm.Open
    ADOstrm.Type = adTypeText
    ADOstrm.Charset = CSET
    ADOstrm.WriteText strUni
    ADOstrm.Position = 0
    ADOstrm.Type = adTypeBinary
    ADOstrm.Position = 3
    buf = ADOstrm.Read()
    ADOstrm.Close
    
    Set ADOstrm = Nothing
  
    For Each n In buf
       tbuf = tbuf & "%" & Hex(n)
    Next
    
    Encode_Uni2UTF = tbuf
    
    Exit Function
    
ErrHandler:
    If ADOstrm Is Nothing = False Then ADOstrm.Close
    Set ADOstrm = Nothing
End Function

markersは地図上に表示させる赤いマーカーの設定なので、表示する必要が無ければ、マクロ内の ImageURL の設定のところで、以下の箇所を削除すれば、マーカーは表示されなくなります。
"&markers=" & Encode_Uni2UTF(Lat) & "," & Encode_Uni2UTF(Lng) &

今回私が作成したフォーマットでは、上記のマクロについても、GeoCoding と同様、 GetImage のボタンを押すだけで、マクロが走るようにしています。
上記のマクロを実行すれば、各地名や住所の ID の名称で、航空写真のファイルがパラメータで設定したアウトプットフォルダ内に保存されていきます。

取得した平安神宮の写真が以下のものになります。
001.png

また、地名ではなく、住所情報で取得した国会議事堂の写真も以下に載せておきます。
005.png

当たり前ですが、前回の記事で載せた国会議事堂の写真と一致しています。
気持ち、今回の写真の方が写りが良さそうですね(笑)

参考情報

今回の記事を書く上で参考にさせていただいたサイトになります。

Google Maps API を使ってみた：
APIキー取得については、色々記事が出ているので、そのうちの1つをご紹介致します。

Google Maps APIが新しくなる！Google Maps Platformの料金体系と必要な設定変更：
Google Maps APIは使用量によっては有料となる場合があります。
このサイトでは使用する際に必要な設定などを紹介してくれているので、こちらも目を通しておいた方が良いでしょう。

Google Maps Geocoding API を使って緯度経度を取得する（xml版）：
緯度経度の取得のマクロの作成時に、大変参考にさせていただきました。
特に、文字列を UTF-8 でエンコードする Function には、その後の航空写真を取得するマクロの作成時にもかなり助けられました。
XML の内容やマクロの詳細について知りたい方は、こちらの記事を参考にされると理解が進むと思います。

VBAで画像をダウンロードして保存する：
VBA で航空写真をダウンロードするマクロの作成時に参考にしました。
URLDownloadToFile 関数の説明もあるので、GetImage のマクロで使用している関数などで分からないことがあれば、こちらのサイトが参考になると思います。

最後に

今回、Excel VBA で 緯度経度の情報や航空写真を取得する方法を色々と調べ、実際にマクロを組んでみました。
最初は Python の方が全体のコード量も少なくて良いなと思っていたのですが、汎用性といった観点で考えてみると、Excel VBA を使って誰でも使えるツールとして作ることも、自分に業務を集中させないという意味で、必要だなと思うようになりました。

6
5
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
6
5

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?