Consulting

Results 1 to 12 of 12

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

  1. #1
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location

    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
    Last edited by georgiboy; 02-06-2018 at 11:49 AM.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  5. #5
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  6. #6
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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?

    Map project.xlsm
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  9. #9
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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.

    Map project.xlsm

    Cheers
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  10. #10
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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?
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  11. #11
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  12. #12
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Can the title of this thread be updated to include the words Google and HTML?

    my project deviated from the original title.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •