Consulting

Results 1 to 12 of 12

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

  1. #1
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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.
    I was not told it was impossible, so i did it.

  2. #2
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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
    I was not told it was impossible, so i did it.

  3. #3
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,300
    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 - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    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
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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.
    I was not told it was impossible, so i did it.

  5. #5
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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.
    I was not told it was impossible, so i did it.

  6. #6
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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
    I was not told it was impossible, so i did it.

  7. #7
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,300
    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 - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    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
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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
    I was not told it was impossible, so i did it.

  9. #9
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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
    I was not told it was impossible, so i did it.

  10. #10
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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?
    I was not told it was impossible, so i did it.

  11. #11
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    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
    I was not told it was impossible, so i did it.

  12. #12
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    558
    Location
    Can the title of this thread be updated to include the words Google and HTML?

    my project deviated from the original title.
    I was not told it was impossible, so i did it.

Posting Permissions

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