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