PDA

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



georgiboy
02-06-2018, 11:01 AM
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

georgiboy
02-07-2018, 08:13 AM
This is what i have been playing with:


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

p45cal
02-07-2018, 10:20 AM
A few years ago I helped out Aussiebear with some mapping here: http://www.vbaexpress.com/forum/showthread.php?48478-Sorting-GPS-marks&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?

georgiboy
02-07-2018, 10:27 AM
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.

georgiboy
02-07-2018, 01:50 PM
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.

georgiboy
02-08-2018, 08:04 AM
So i have been tinkering with different ideas and have so far come up with the following 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?

21576

p45cal
02-08-2018, 11:13 AM
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?

georgiboy
02-08-2018, 11:40 AM
Pretty much the whole thing from here:
https://www.codeproject.com/Tips/1036941/Excel-Google-Maps-Add-In
From what I read in the license it’s open source, please let me know if I am wrong

cheers

georgiboy
02-11-2018, 08:28 AM
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.

21592

Cheers

georgiboy
02-12-2018, 08:57 AM
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?

georgiboy
02-19-2018, 09:17 AM
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:


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.


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

georgiboy
02-19-2018, 10:07 AM
Can the title of this thread be updated to include the words Google and HTML?

my project deviated from the original title.