[SOLVED:] MS MapPoint and MS Excel, plot latitude and longitude on a map

MS MapPoint and MS Excel, plot latitude and longitude on a map

Hi all,

I once created a load of code that links Excel with MapPoint and plots locations on the map based on criteria, it would place different icons on the map depending on this criteria. 70+ locations.

My question is as MapPoint software is now redundant, is there any other MS solution to do the same, even inside Excel itself?

I am open to different suggestions but limited as to what I can install as I don’t have administrator access.

I was thinking of Bing maps but I have slow internet speed at my workplace, unless refreshing the data points on Bing is not resource hungry?

I have no new code as of yet just wondering if anyone has ever tried to do this.

Excel 2010

thanks in advance

This is what i have been playing with:

Code:

Sub update_maps() Dim url As String, tmpStr As String Dim MyBrows, wb Dim i As Long Dim ob As Object For Each ob In Sheet1.OLEObjects ob.Delete Next ob Set MyBrows = Sheet1.OLEObjects.Add(ClassType:="Shell.Explorer.2", _ Left:=147, Top:=60.75, Width:=900, Height:=800) Set wb = MyBrows.Object url = "https://www.google.co.uk/maps/place/" For i = 2 To Sheet1.Range("D" & Rows.Count).End(xlUp).Row tmpStr = tmpStr & "&markers=size:" & Sheets("Data").Cells(i, 3).Value & "%7Ccolor:" & Sheets("Data").Cells(i, 4).Value & "%7C" & "label:1%7C" & George + Clark & _ Application.WorksheetFunction.Substitute(Sheets("Data").Cells(i, 1).Value, " ", "+") & "," & _ Application.WorksheetFunction.Substitute(Sheets("Data").Cells(i, 2).Value, " ", "+") Next url = url & tmpStr & "&sensor=false" wb.navigate url End Sub

I am getting unsupported browser error as i am using IE11 i think, is there a way around this?

Cheers

A few years ago I helped out Aussiebear with some mapping here: http://www.vbaexpress.com/forum/show...rks&highlight=
Have a wander through the thread.
In msg#27 there's a link to some plotted points/areas
Link at the end of msg#37 too.
Check out msg#42 and its link to a file.

Why not provide some coordinates or a file to use with your code in the last message?

Thank you I will have a look.

I haven’t provided a file or data yet as they are at work and I had a day off today.

I will look to paste some data tomorrow. The data is literally a shop name and lat and long.

Had a quick look at the file (I will look more in depth tomorrow) and messages. Looked at more info online also.

Now thinking I maybe better off plotting onto a chart with a map background and have data labels to display any additional info.

like I say, thanks again for pointing me in the right direction.

1 Attachment(s)

So i have been tinkering with different ideas and have so far come up with the following code:

Code:

Sub PlotOnGoogle() Dim rCell As Range, FileName As String, StoreNum As String Dim Latitude As String, Longitude As String Dim StoreName As String, StoreType As String, StoreTrailers As String FileName = ThisWorkbook.path & "\Icons\Google Maps.html" ' custom icons and temp file 'create the fist part of the file ############################################################################################################## Open FileName For Output As #1 Print #1, "<!DOCTYPE html>" Print #1, "<html>" Print #1, " <head>" Print #1, " <meta name=" + Chr$(34) + "viewport" + Chr$(34) + " content=" + Chr$(34) + "initial-scale=1.0, user-scalable=no" + Chr$(34) + ">" Print #1, " <meta charset=" + Chr$(34) + "utf-8" + Chr$(34) + ">" Print #1, " <title>Google Maps</title>" Print #1, " <style>" Print #1, " html, body, #map-canvas" Print #1, " {" Print #1, " height: 100%;" Print #1, " margin: 0px;" Print #1, " padding: 0px" Print #1, " }" Print #1, " </style>" Print #1, " <script src=" + Chr$(34) + "https://maps.googleapis.com/maps/api/js?v=3.exp&signed_in=true" + Chr$(34) + "></script>" Print #1, " <script>" Print #1, "" Print #1, "function initialize()" Print #1, "{" Print #1, " var mapOptions =" Print #1, " {" Print #1, " zoom: 9," Print #1, " center: new google.maps.LatLng(51.405180, -0.406724)" Print #1, " };" Print #1, "" Print #1, " var map = new google.maps.Map(document.getElementById('map-canvas'), mapOptions);" Print #1, "" Print #1, " var imageSC = 'file://C:/Users/A/Desktop/Icons/SC.png';" Print #1, " var imageSM = 'file://C:/Users/A/Desktop/Icons/SM.png';" Print #1, " var imageBH = 'file://C:/Users/A/Desktop/Icons/BH.png';" Print #1, " var imageDepot = 'file://C:/Users/A/Desktop/Icons/Depot.png';" Print #1, " var imagePFS = 'file://C:/Users/A/Desktop/Icons/PFS.png';" 'create the specific pin part of the file ########################################################################################################## For Each rCell In Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Cells Latitude = rCell.Offset(, 2).Value Longitude = rCell.Offset(, 3).Value StoreNum = rCell.Value StoreName = rCell.Offset(, 1).Value StoreType = rCell.Offset(, 4).Value StoreTrailers = rCell.Offset(, 5).Value Print #1, "" Print #1, " var marker" + CStr(rCell.Row) + "= new google.maps.Marker({" Print #1, " position: new google.maps.LatLng(" + Latitude + ", " + Longitude + ")," Print #1, " title: " + Chr$(34) + StoreNum + "\n" + StoreName + "\n" + StoreType + "\n" + StoreTrailers + Chr$(34) + "," Print #1, " map: map," 'Print #1, " icon:image" & rCell.Offset(, 4).Value & "," Print #1, " });" Print #1, "" Print #1, " google.maps.event.addListener(marker" + CStr(rCell.Row) + ", 'dragend', function(event)" Print #1, " {" Print #1, " var Title = marker" + CStr(rCell.Row) + ".getTitle();" Print #1, " var SubStrings = Title.split(" + Chr$(34) + "\n" + Chr$(34) + ");" Print #1, " });" Next rCell 'create the last part of the file ############################################################################################################## Print #1, "}" Print #1, "" Print #1, "google.maps.event.addDomListener(window, 'load', initialize);" Print #1, "" Print #1, " </script>" Print #1, " </head>" Print #1, " <body>" Print #1, " <div id=" + Chr$(34) + "map-canvas" + Chr$(34) + "></div>" Print #1, " </body>" Print #1, "</html>" Close #1 ActiveWorkbook.FollowHyperlink Address:=FileName, NewWindow:=False End Sub

Now everything works fine in regards to it does what i want it to.

(I have commented out the line that applies the custom icons at the moment)

Is there a way i can force all of the info bubbles to be displayed as at current they are only a singular mouse over event on the map?

Attachment 21576

That's rather good.
There's loads of info on the web about this; where did you end up getting most of your help from?

Pretty much the whole thing from here:
https://www.codeproject.com/Tips/103...le-Maps-Add-In
From what I read in the license it’s open source, please let me know if I am wrong

cheers

1 Attachment(s)

So i have added things like zoom to pins and optional info windows, i am happy with it so far.

Is there a way i can get this to load in a sheet web browser instance, i tried but got errors?

At the moment it fires a new window in default browser.

Attachment 21592

Cheers

I have been thinking about creating some VBA to edit the registry (current user) to point the webbrowser object wrapper at a newer version of IE.

would this be considered bad practice?
Is there any other workarounds?

I am posting this code for reference in case anyone has been following this thread.

Did some more work on this so thought i would update:

So I ended up changing the registry to point Excel's WebBrowser object at a newer version of IE, i automated this with the below code. There may be better ways of doing this but here is what i ended up with:

Code:

Sub CheckForKey() Dim Root As String, Key As String, Key2 As String Dim MyWS As Object, RegKeyExists As Boolean Set MyWS = CreateObject("WScript.Shell") RegKeyExists = True Root = "HKEY_CURRENT_USER\" Key = Root & "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION\" & "excel.exe" Key2 = Root & "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION\" & "excel" & ".vshost.exe" On Error Resume Next If MyWS.RegRead(Key) = "" Then RegKeyExists = False If RegKeyExists = False Then MyWS.RegWrite Key, 11001, "REG_DWORD" MyWS.RegWrite Key2, 11001, "REG_DWORD" MsgBox "You will need to restart MS Excel for this to work" & vbNewLine & vbNewLine & _ "This will happen only once", vbInformation, "Adding entry to registry" End If End Sub

Then i changed the main code to store the HTML in an array and passed this straight to the WebBrowser object as a document, I also made the InfoWindow and external browser optional, see below:
You could make your own icons, i think they need to be a 22x22 png.

Code:

Sub PlotOnGoogle() Dim rCell As Range, FileName As String, StoreNum As String Dim Latitude As String, Longitude As String, NameShow As Boolean Dim StoreName As String, StoreType As String, StoreTrailers As String Dim x As Long, htmlVar() As Variant, PlotExt As Boolean x = 0 NameShow = True PlotExt = False FileName = Environ("Temp") & "\GoogleMaps.html" 'create the fist part of the html var x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "<!DOCTYPE html>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "<html>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <head>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <meta name=" + Chr$(34) + "viewport" + Chr$(34) + " content=" + Chr$(34) + "initial-scale=1.0, user-scalable=no" + Chr$(34) + ">" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <meta charset=" + Chr$(34) + "utf-8" + Chr$(34) + ">" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <title>GoogleMaps</title>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <style>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " html, body, #map-canvas" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " {" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " height: 100%;" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " margin: 0px;" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " padding: 0px" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " }" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " </style>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <script src=" + Chr$(34) + "https://maps.googleapis.com/maps/api/js?v=3.27" + Chr$(34) + "></script>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <script>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "function initialize()" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "{" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var mapOptions =" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " {" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " zoom: 6," x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " center: new google.maps.LatLng(51.405180, -0.406724)" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " };" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var map = new google.maps.Map(document.getElementById('map-canvas'), mapOptions);" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var imageSC = 'http://maps.google.com/mapfiles/ms/icons/green.png';" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var imageSM = 'http://maps.google.com/mapfiles/ms/icons/red.png';" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var imagePFS = 'http://maps.google.com/mapfiles/ms/icons/blue.png';" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var imageBH = 'http://maps.google.com/mapfiles/ms/icons/pink-dot.png';" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var imageDepot = 'http://maps.google.com/mapfiles/ms/icons/yellow-dot.png';" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "bounds = new google.maps.LatLngBounds();" 'create the specific pin part of the var For Each rCell In Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Cells Latitude = rCell.Offset(, 2).Value Longitude = rCell.Offset(, 3).Value StoreNum = rCell.Value StoreName = rCell.Offset(, 1).Value StoreType = rCell.Offset(, 4).Value StoreTrailers = rCell.Offset(, 5).Value x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var marker" + CStr(rCell.Row) + "= new google.maps.Marker({" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " position: new google.maps.LatLng(" + Latitude + ", " + Longitude + ")," x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " title: " + Chr$(34) + StoreName + "\n" + StoreNum + "\n" + StoreType + "\n" + StoreTrailers + Chr$(34) + "," x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " map: map,icon:image" & rCell.Offset(, 4).Value & "});" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "var loc = new google.maps.LatLng(marker" + CStr(rCell.Row) + ".position.lat(), marker" + CStr(rCell.Row) + ".position.lng());" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "bounds.extend(loc);" If NameShow = True Then x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "var infowindow" + CStr(rCell.Row) + " = new google.maps.InfoWindow({content:'" & StoreName & "'});" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "infowindow" + CStr(rCell.Row) + ".open(map,marker" + CStr(rCell.Row) + ");" End If x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " google.maps.event.addListener(marker" + CStr(rCell.Row) + ", 'dragend', function(event)" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " {" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var Title = marker" + CStr(rCell.Row) + ".getTitle();" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " var SubStrings = Title.split(" + Chr$(34) + "\n" + Chr$(34) + ");});" Next rCell 'create the last part of the var x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "map.fitBounds(bounds);" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "map.panToBounds(bounds);" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "}" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "google.maps.event.addDomListener(window, 'load', initialize);" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " </script>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " </head>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <body>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " <div id=" + Chr$(34) + "map-canvas" + Chr$(34) + "></div>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = " </body>" x = x + 1: ReDim Preserve htmlVar(x): htmlVar(x) = "</html>" If PlotExt = True Then Open FileName For Output As #1 Print #1, Join(htmlVar, vbNewLine) Close #1 ActiveWorkbook.FollowHyperlink Address:=FileName, NewWindow:=False Else With Sheet1.WebBrowser1.Document .Open .write Join(htmlVar, vbNewLine) .Close End With End If End Sub

The final code has more bells and whistles but thought i would post this basic version.

Hope this helps

Can the title of this thread be updated to include the words Google and HTML?

my project deviated from the original title.