VBA 応用2017.06.29 2018.03.21 taka

ExcelVBAとGoogleマップの連携

1 ExcelVBAとGoogleマップの連携

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

taka

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

ExcelVBAとGoogleマップの連携

お知らせ
※2017/10/1現在この記事のコードは一部使用できないようです。
【ExcelVBAとGoogleマップの連携2】にて代替え案をご紹介しております。

今回はExcel VBAを使って【GoogleMap】を表示する方法をご紹介します！

ExcelでGoogleマップを表示する方法はいくつか存在します、今回ご紹介するのはその中の一つです。

ネットでもいくつか紹介されていた記事は見つけましたが、コードを公開しているだけであまり解説がなかったり、AccessVBAのコードだったりとしたので個人的に編集して何とか使用できるレベルにしたつもりですので是非ご覧ください。

GoogleMapを表示する準備

まずGoogleマップを表示する為に必要な準備をしていきましょう。以下の手順を踏んでいきます。

表示させるユーザーフォームを作成。
WebBrowserコントロールで表示するHTMLを作成する
HTMLに読み込ませるJavaScriptを作成する
ユーザーフォームMapをに表示させ、JavaScriptに書き込むVBAコードを作成する

今回は3つのファイルを連携させるような形になります。３つの関係性はこのような感じで思ってください。

1.表示させるユーザーフォームを作成

ますGoogleマップを表示するためのユーザーフォームを作成していきます。GoogleマップはWEBページなのでユーザーフォームのWebBrowserコントロールを使います。

WebBrowserコントロール導入についてはこちらで確認してください。

E-VBA

ウェブページを表示するコントロール【WebBrowserの使い方】

ウェブページを表示するコントロール【WebBrowserの使い方】こんばんはtakaです、今回はユーザーフォーム上でウェブページを回覧をすることができるコントロール【WebBr...

イメージとしてはこんな感じです。

このユーザーフォームに記述するコードは下記のコードだけで十分です。

Private Sub UserForm_Initialize()
'スクリプトエラーの表記を無視する
WebBrowser1.Silent = True
End Sub

Private Sub UserForm_Initialize()

'スクリプトエラーの表記を無視する

WebBrowser1.Silent = True

End Sub

※スクリプトエラーが発生し、制御不能になってしまう恐れがあるのでそれを最低限防ぐコードです。今後対策がわかり次第記述します。

2.WebBrowserコントロールで表示するHTMLを作成する

続きまして上記のユーザーフォームを表示させるためのHTMLファイルを作成しましょう。

今回表示するHTMLはこちらのwebサイト様のHTMLを流用させていただきました。

http://tsware.jp/download/accgmap/

※HTMLが少し古いバージョンだったので最新のHTML5に書き換えて使用しています。

ファイル名:index.html

<!-- saved from url=(0017)http://localhost/ -->
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8" />
<meta name="viewport" content="initial-scale=1.0, user-scalable=no" />
<title></title>
<script type="text/javascript" src="http://maps.google.com/maps/api/js?sensor=false"></script>
<script type="text/javascript" src="mapdata.js"></script>
<script type="text/javascript">
var geocoder;
var map;
var currentInfoWindow = null;
function initialize() {
geocoder = new google.maps.Geocoder();
var myOptions = {zoom: mapzoom, mapTypeId: google.maps.MapTypeId.ROADMAP}
map = new google.maps.Map(document.getElementById("map_canvas"), myOptions);
for (var i = 0; i < places.length; i++) {
var place = places[i];
var info = '<b>' + place[1] + '</b><br/><br/>' + place[0];
codeAddress(place[0], info, place[2]);
}
}
function codeAddress(address, info, flg) {
geocoder.geocode({'address': address}, function(results, status) {
if (status == google.maps.GeocoderStatus.OK) {
if (flg == 0) {
map.setCenter(results[0].geometry.location);
}
else {
var marker = new google.maps.Marker({map: map, position: results[0].geometry.location});
var infowindow = new google.maps.InfoWindow({content: info});
google.maps.event.addListener(marker, 'click', function() {
if (currentInfoWindow) {
currentInfoWindow.close();
}
infowindow.open(map,marker);
currentInfoWindow = infowindow;
});
}
}
});
}
</script>
</head>
<body onload="initialize()" style="margin:0px; padding:0px">
<div id="map_canvas" style="width:100%; height:100%;"></div>
</body>
</html>

<!DOCTYPE html>

<html>

<head>

var geocoder;

var map;

var currentInfoWindow = null;

function initialize() {

geocoder = new google.maps.Geocoder();

var myOptions = {zoom: mapzoom, mapTypeId: google.maps.MapTypeId.ROADMAP}

map = new google.maps.Map(document.getElementById("map_canvas"), myOptions);

for (var i = 0; i < places.length; i++) {

var place = places[i];

var info = '<b>' + place[1] + '</b><br/><br/>' + place[0];

codeAddress(place[0], info, place[2]);

}

function codeAddress(address, info, flg) {

geocoder.geocode({'address': address}, function(results, status) {

if (status == google.maps.GeocoderStatus.OK) {

if (flg == 0) {

map.setCenter(results[0].geometry.location);

}

else {

var marker = new google.maps.Marker({map: map, position: results[0].geometry.location});

var infowindow = new google.maps.InfoWindow({content: info});

google.maps.event.addListener(marker, 'click', function() {

if (currentInfoWindow) {

currentInfoWindow.close();

}

infowindow.open(map,marker);

currentInfoWindow = infowindow;

});

}

});

}

</script>

</head>

</body>

</html>

3.HTMLに読み込ませるJavaScriptを作成する

次はHTMLファイルが地図データを読み込むためのJavaScriptを作成しましょう。

ファイルの中身はExcel側で書き込むので【メモ帳】などで新規作成し、ファイル名を【mapdata.js】で作成してください。

4.ユーザーフォームMapをに表示させ、JavaScriptに書き込むVBAコードを作成する

最後にユーザーフォームにHTMLを表示させ、先ほど作成した【mapdata.js】の中身を書き込むコードを作成しましょう

まず【mapdata.js】に書き出しをするために参照設定をする必要があります。

ツール→参照設定→【Microsoft ActiveX Data Objects 〇.〇 Library】
※〇は最新のバージョンを設定してください。

これで準備は完了です、次にコードですが、下記のコードはA列のセルをダブルクリックしたときにA列のデータを読み込んで地図を表示するコードです。

コードを記述するところは赤丸のところに記述してください。

解説はコード中のコメントでしていますのでご参考ください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strm As New ADODB.Stream
Dim acbPath As String
Dim str As String
Dim strData As String
'開いているブックのパスを取得
acbPath = ActiveWorkbook.Path
'-----地図情報作成(mapdata.jsに書き込む内容)
'1 地図を表示するズームを数値で設定
'2地図の中心にする住所を設定
'3アイコンを表示する住所を設定
strData = "var mapzoom = " & 15 & ";" & vbCrLf & _
"var places = [" & vbCrLf & _
"['" & ActiveCell.Text & "','" & ActiveCell.Offset(, 1).Text & "'" & ", 0]," & vbCrLf & _
"['" & ActiveCell.Text & "','" & ActiveCell.Offset(, 1).Text & "', 1]," & vbCrLf & _
"];" & vbCrLf
'------地図情報作成終了
With strm   'strData (地図情報)をmapdata.jsに保存
.Charset = "UTF-8"  '文字コードの指定
.Open
.WriteText strData  '保存する内容
.SaveToFile acbPath & "\mapdata.js", adSaveCreateOverWrite  '保存先の設定、保存の設定
.Close: Set strm = Nothing
End With
str = acbPath & "\index.html"    'WebBrowser1に表示するHTMLのパスを設定
UserForm1.Show
UserForm1.WebBrowser1.Navigate str  '.WebBrowserにindex.html　を表示する
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim strm As New ADODB.Stream

Dim acbPath As String

Dim str As String

Dim strData As String

'開いているブックのパスを取得

acbPath = ActiveWorkbook.Path

'-----地図情報作成(mapdata.jsに書き込む内容)

'1 地図を表示するズームを数値で設定

'2地図の中心にする住所を設定

'3アイコンを表示する住所を設定

strData = "var mapzoom = " & 15 & ";" & vbCrLf & _

"var places = [" & vbCrLf & _

"['" & ActiveCell.Text & "','" & ActiveCell.Offset(, 1).Text & "'" & ", 0]," & vbCrLf & _

"['" & ActiveCell.Text & "','" & ActiveCell.Offset(, 1).Text & "', 1]," & vbCrLf & _

"];" & vbCrLf

'------地図情報作成終了

With strm 'strData (地図情報)をmapdata.jsに保存

.Charset = "UTF-8" '文字コードの指定

.Open

.WriteText strData '保存する内容

.SaveToFile acbPath & "\mapdata.js", adSaveCreateOverWrite '保存先の設定、保存の設定

.Close: Set strm = Nothing

End With

str = acbPath & "\index.html" 'WebBrowser1に表示するHTMLのパスを設定

UserForm1.Show

UserForm1.WebBrowser1.Navigate str '.WebBrowserにindex.html　を表示する

End Sub

結果

間違っていなければ下記の画像のような結果が表示されていると思います。

最後に

いかがでしたでしょうか？ExcelとGoogleマップを連携させると住所録などの新しい使用法が生まれるのではないかと思います。今回のコードが何かの役に立てば幸いです。

今回ご紹介したファイルはフリーでダウンロードできるようにしておきますのでご自由にお使いください。

ファイルダウンロード

Excel×Googleマップ 21.91 KB

Download

お知らせ
※2017/10/1現在このファイルのコードは一部使用できないようです。
【ExcelVBAとGoogleマップの連携2】にて代替え案をご紹介しております。

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

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

7 件のコメント

内容を拝見致しました、素晴らしいと思います

が、当方インターネットエクスプローラは11なので上手く起動しないのでしょうか…？
７迄しか動かないのでしょうか…？
当方の環境はWindows10、エクセルバージョンはMicrosoft office Home and Business 2013を使用しております

動かない現象内容↓
・sample.xlsmを開き、A2セルをダブルクリックしてuserform1が立ち上がるのですが、肝心のマップが
　表示されません…真っ白なのです。ファイルダウンロードし、圧縮ファイルを解凍しフォルダの
　sample.xlsmを開き運営者様のように使用すれば稼働すると思われるのですが…
　なんででしょうか？(;´･ω･)

是非活用したいと思いますのでご返信お待ちしております。