エクセルでワンクリックでルート検索したいのですが…

解決済

質問者：kyo-maru
質問日時：2012/03/01 12:08
回答数：1件

エクセルでＡ列に住所が入力されているリストがあるのですが、
会社からこの住所までのルート検索をワンクリックで出来ないでしょうか？

使用ブラウザはグーグルクロムで
使用サイトはグーグルマップの車でのルート検索が出来れば助かります。

よろしくお願いしますm(_ _)m

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (1件)

ベストアンサー優先
最新から表示
回答順に表示

No.1ベストアンサー

回答者： f272
回答日時：2012/03/01 16:50

面白そうなのでVBAで作ってみた。

データのあるシートのシートマクロとして使ってください。
会社の住所は，適当に変更してね。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Text = "" Then Exit Sub
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Filename = fso.GetSpecialFolder(2) & "googlemaps.html"
With CreateObject("ADODB.Stream")
.Type = 2
.Charset = "UTF-8"
.Open
.WriteText "<!DOCTYPE html>", 1
.WriteText "<html>", 1
.WriteText "<head>", 1
.WriteText "<meta name=""viewport"" content=""width=device-width, initial-scale=1.0, user-scalable=no"" /> <meta http-equiv=""content-type"" content=""text/html; charset=UTF-8"" />", 1
.WriteText "<link href=""http://code.google.com/apis/maps/documentation/j … rel=""stylesheet"" type=""text/css"" />", 1
.WriteText "<title>Google Maps JavaScript API v3</title>", 1
.WriteText "<script type=""text/javascript"" src=""http://maps.google.com/maps/api/js?sensor=false" … 1
.WriteText "<script type=""text/javascript"">", 1
.WriteText "var rendererOptions ={draggable: true,preserveViewport:false};", 1
.WriteText "var directionsDisplay = new google.maps.DirectionsRenderer(rendererOptions);", 1
.WriteText "var directionsService = new google.maps.DirectionsService();", 1
.WriteText "var map;", 1
.WriteText "function initialize()", 1
.WriteText "{", 1
.WriteText " var myOptions = {center: google.maps.LatLng(35.67849, 139.39178), zoom: 10, mapTypeId: google.maps.MapTypeId.ROADMAP};", 1
.WriteText " map = new google.maps.Map(document.getElementById(""map_canvas""), myOptions);", 1
.WriteText " directionsDisplay.setMap(map);", 1
.WriteText " google.maps.event.addListener(directionsDisplay, 'directions_changed', function() {});", 1
.WriteText " var request = {", 1
.WriteText " origin: ""東京都渋谷区恵比寿1－19－15"" ,", 1
.WriteText " destination: """ & Target.Text & """ ,", 1
.WriteText " travelMode: google.maps.DirectionsTravelMode.DRIVING,", 1
.WriteText " unitSystem: google.maps.DirectionsUnitSystem.METRIC,", 1
.WriteText " optimizeWaypoints: true,", 1
.WriteText " avoidHighways: false,", 1
.WriteText " avoidTolls: false", 1
.WriteText " };", 1
.WriteText " directionsService.route(request, function(response, status) { ", 1
.WriteText " if (status == google.maps.DirectionsStatus.OK) {directionsDisplay.setDirections(response);}", 1
.WriteText " });", 1
.WriteText "}", 1
.WriteText "</script>", 1
.WriteText "</head>", 1
.WriteText "<body onload=""initialize()"">", 1
.WriteText "<div id=""map_canvas""></div>", 1
.WriteText "</body>", 1
.WriteText "</html>", 1
.SaveToFile Filename, 2
.Close
End With
Dim WSH
Set WSH = CreateObject("Wscript.Shell")
WSH.Run Filename, 3
End Sub