ベストアンサー

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

2012/03/01 12:08

エクセルでＡ列に住所が入力されているリストがあるのですが、会社からこの住所までのルート検索をワンクリックで出来ないでしょうか？使用ブラウザはグーグルクロムで使用サイトはグーグルマップの車でのルート検索が出来れば助かります。よろしくお願いしますm(_ _)m

kyo-maru
お礼率71% (5/7)

その他MS Office製品
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

f272
ベストアンサー率46% (8467/18126)

2012/03/01 16:50 回答No.1

面白そうなので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/javascript/examples/default.css"" 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""></script>", 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

質問者