VBA　YahooAPIを使って２つの場所の経路を取得してみた

1 今回使用するYahooAPI
- 1.1 今回のプログラムの流れ
- 1.2 今回作成したフォーム
2 VBAで経路地図を表示させるサンプルコード
- 2.1 YahooAPI　経路地図作成ファイル
- 2.2 共有:

この記事を書いた人
最新の記事

taka

あることがキッカケでVBAを独学で勉強しました、今ではブログを通してVBAでできることを解説しつつ、VBAや他の言語の勉強、ブログ運営の勉強をしています(^^♪

今回使用するYahooAPI

:コンテンツジオコーダAPI・・・キーワードから緯度経度を取得するAPI
経路地図API・・・出発地と目的地の緯度経度をもとに経路を画像で作成するAPI

この二つのAPIを使用して作成してみました(‘ω’)

今回のプログラムの流れ

今回のプログラムの流れはこのような形です。

住所・キーワードを入力してAPIで座標(緯度・経度)を取得する。
Yahoo!ジオコーダAPIはUTF-8でデータを送る必要があるのでWorksheet関数の【EncodeURL関数】を使用する。
レスポンスで返ってきた緯度・経度の順番が、経路地図APIで使用する順番と反対なので、一度配列に入れてから入れ替える。
取得した座標をもとに画像をリクエスト、【WebBrowserコントロール】を使用して表示する。

大まかに言うとこのような感じです。

今回作成したフォーム

今回作成したフォームは画像のような形です。

今回はプログラムの流れを見ていただくためにわざとTextBoxコントロールを多めにして表示をしています。実際に必要なのは２つあれば十分です(^^♪

コントロール	役割
TextBox1	YahooAPIキーを入力
TextBox2	出発地の住所やキーワードを入力
TextBox3	取得した出発地の座標を表示
TextBox4	出発地住所をもとにUTF-8エンコードした文字列を表示
TextBox5	到着地の住所やキーワードを入力
TextBox6	取得した到着地の座標を表示
TextBox7	到着地住所をもとにUTF-8エンコードした文字列を表示
CommandButton1	取得した座標をもとにYahoo!へリクエストを送る
WebBrowser1	Yahoo!から得た地図画像を表示する

VBAで経路地図を表示させるサンプルコード

なるべくコードは少なく作成したつもりです(*_*;

私自身まだHTTPリクエストには不慣れなため、もっと上手い使い方があるのかもしれませんが、とりあえず動作はしましたので、よければご利用ください(^^♪

注意事項とお願い

今回のコードは【Microsoft XML, v6.0】を参照設定して作成しております。
参照設定についてはこちらを参考にしてください。※参照設定しない場合も対応できるようにしてあります
申し訳ありませんが、Yahoo!APIキーはご自身でご用意ください。
今回使用したAPIの詳しい使用は下記からご覧ください
リンク:コンテンツジオコーダAPI
リンク:経路地図API
Yahoo!APIキーの取得方法は【VBA　郵便番号から住所を取得する方法】をご覧ください
また、APIの使用についてはYahoo!の規約に遵守するようにお願いします。

Private Sub CommandButton1_Click()
'取得した座標をもとに、WebBrowserコントロールに地図の画像を表示させる
WebBrowser1.Navigate "https://map.yahooapis.jp/course/V1/routeMap?appid=" & TextBox1.Value & _
"&route=" & TextBox3.Text & "," & TextBox6.Text & "&width=600&height=500"
End Sub
Private Sub TextBox2_Change()
'住所やキーワードをEncodeURL関数を使用してUTF-8に変換
TextBox4.Text = Application.WorksheetFunction.EncodeURL(TextBox2.Value)
End Sub
Private Sub TextBox5_Change()
'住所やキーワードをEncodeURL関数を使用してUTF-8に変換
TextBox7.Text = Application.WorksheetFunction.EncodeURL(TextBox5.Value)
End Sub
Private Sub TextBox4_Change()
'UTF-8に変換されたコードをもとに座標を取得
TextBox3.Text = yahooAddress(TextBox4.Text)
End Sub
Private Sub TextBox7_Change()
'UTF-8に変換されたコードをもとに座標を取得
TextBox6.Text = yahooAddress(TextBox7.Text)
End Sub
Function yahooAddress(Addresscode As String)
'YahooAPIを使って緯度・経度を取得する関数
Dim XMLArr
Dim start As Long
Dim goal As Long
Dim objHttp As XMLHTTP60 '【Microsoft XML, v6.0】を参照設定してある場合はこれで
Set objHttp = New XMLHTTP60 '【Microsoft XML, v6.0】を参照設定してある場合はこれで
'Dim objHttp As Object '参照設定しない場合はこれで
'Set objHttp = CreateObject("MSXML2.XMLHTTP") '参照設定しない場合はこれで
'↓GETリクエストをヤフーに送る
objHttp.Open "GET", "https://map.yahooapis.jp/geocode/cont/V1/contentsGeoCoder?appid=" & TextBox1.Text & "&query=" & Addresscode, False
objHttp.Send
'responseTextでレスポンスを取得
XMLArr = objHttp.responseText
'座標が格納されている<Coordinates>の間のデータを取得
start = InStr(XMLArr, "<Coordinates>")
goal = InStr(XMLArr, "</Coordinates>")
'<Coordinates>がない場合の処理
If start = 0 Or goal = 0 Then '
GoTo skip
End If
'取得した位置の間の文字をMid関数で抜き出す
XMLArr = Mid(XMLArr, start + 13, goal - start - 13)
'緯度経度の順番を入れ替えたいので一度配列に格納
XMLArr = Split(XMLArr, ",")
'緯度経度の順番を入れ替える
yahooAddress = XMLArr(1) & "," & XMLArr(0)
skip:
End Function

Private Sub CommandButton1_Click()

'取得した座標をもとに、WebBrowserコントロールに地図の画像を表示させる

WebBrowser1.Navigate "https://map.yahooapis.jp/course/V1/routeMap?appid=" & TextBox1.Value & _

"&route=" & TextBox3.Text & "," & TextBox6.Text & "&width=600&height=500"

End Sub

Private Sub TextBox2_Change()

'住所やキーワードをEncodeURL関数を使用してUTF-8に変換

TextBox4.Text = Application.WorksheetFunction.EncodeURL(TextBox2.Value)

End Sub

Private Sub TextBox5_Change()

'住所やキーワードをEncodeURL関数を使用してUTF-8に変換

TextBox7.Text = Application.WorksheetFunction.EncodeURL(TextBox5.Value)

End Sub

Private Sub TextBox4_Change()

'UTF-8に変換されたコードをもとに座標を取得

TextBox3.Text = yahooAddress(TextBox4.Text)

End Sub

Private Sub TextBox7_Change()

'UTF-8に変換されたコードをもとに座標を取得

TextBox6.Text = yahooAddress(TextBox7.Text)

End Sub

Function yahooAddress(Addresscode As String)

'YahooAPIを使って緯度・経度を取得する関数

Dim XMLArr

Dim start As Long

Dim goal As Long

Dim objHttp As XMLHTTP60 '【Microsoft XML, v6.0】を参照設定してある場合はこれで

Set objHttp = New XMLHTTP60 '【Microsoft XML, v6.0】を参照設定してある場合はこれで

'Dim objHttp As Object '参照設定しない場合はこれで

'Set objHttp = CreateObject("MSXML2.XMLHTTP") '参照設定しない場合はこれで

'↓GETリクエストをヤフーに送る

objHttp.Open "GET", "https://map.yahooapis.jp/geocode/cont/V1/contentsGeoCoder?appid=" & TextBox1.Text & "&query=" & Addresscode, False

objHttp.Send

'responseTextでレスポンスを取得

XMLArr = objHttp.responseText

'座標が格納されている<Coordinates>の間のデータを取得

start = InStr(XMLArr, "<Coordinates>")

goal = InStr(XMLArr, "</Coordinates>")

'<Coordinates>がない場合の処理

If start = 0 Or goal = 0 Then '

GoTo skip

End If

'取得した位置の間の文字をMid関数で抜き出す

XMLArr = Mid(XMLArr, start + 13, goal - start - 13)

'緯度経度の順番を入れ替えたいので一度配列に格納

XMLArr = Split(XMLArr, ",")

'緯度経度の順番を入れ替える

yahooAddress = XMLArr(1) & "," & XMLArr(0)

skip:

End Function

ダウンロード

当サイトの免責事項をお読みになってからお使いください。

YahooAPI　経路地図作成ファイル

1 file(s) 16.07 KB

Download

フォロー・チャンネル登録お願いします

■Twitterフォロー

Follow @takabou63

■YouTubeチャンネル登録

ファイルやコードの利用、WEBサイトの利用について

サンプルコードなどは当サイトの免責事項をよくお読みになってからお使いください。

カテゴリーで絞る

月で探す

VBA　YahooAPIを使って２つの場所の経路を取得してみた

taka

最新記事 by taka (全て見る)

今回使用するYahooAPI

今回のプログラムの流れ

今回作成したフォーム

VBAで経路地図を表示させるサンプルコード

ダウンロード

YahooAPI　経路地図作成ファイル

フォロー・チャンネル登録お願いします

ファイルやコードの利用、WEBサイトの利用について

Sponsored Link

コメントを残すコメントをキャンセル

アクセスカウンター

プロフィール

Facebook

Twitter

当サイトの環境について

特別企画実施中

アーカイブ

最近の投稿

メニュー

カテゴリーで絞る

月で探す

taka

最新記事 by taka (全て見る)

今回使用するYahooAPI

今回のプログラムの流れ

今回作成したフォーム

VBAで経路地図を表示させるサンプルコード

ダウンロード

YahooAPI 経路地図作成ファイル

フォロー・チャンネル登録お願いします

ファイルやコードの利用、WEBサイトの利用について

Sponsored Link

共有:

コメントを残す コメントをキャンセル

RECOMMENDこちらの記事も人気です。

VBA ExcelとAccessの連携まとめ

VBA「Escキー」の中断を制御する「EnableCancelKeyプロ…

Excel VBA高速化テクニック1【画面描写を止める】

ExcelVBAで簡単にユーザーフォームのサイズ変更する方法

VBAでミニゲームを作ってみました【クリックナンバー】

Excelの文字数カウントツール【便利？ツール】

VBAで住所録からアイコンを立てるマップを作成してみた

コントロール【ListBox】

アクセスカウンター

プロフィール

Facebook

Twitter

当サイトの環境について

特別企画実施中

アーカイブ

最近の投稿

メニュー

YahooAPI　経路地図作成ファイル

コメントを残すコメントをキャンセル