Google Maps VBA integration

T

Trebor8484

Board Regular
Joined
Oct 27, 2018
Messages
69
Office Version
  1. 2013
Platform
  1. Windows
Hi,

I have the code below that takes lat/longs from a file and plots them on a Google Map. The code generates a html file which automatically fires up in the web browser.

I have a couple of issues with this where I need to make amendments to the vba code and the underlying html.

Firstly I need to add a permanent label marker on each pin to show the time stamp from column C. Then when I click on a pin I need to see data relating to that marker including the information shown in column D plus possibly additional columns of data as well, however the code below seems to suggest that I can only have a 3 columns of data for this to work?

For the label marker, this works as a hard coded solution but I need to incorporate this or something similar into my macro

var marker2= new google.maps.Marker(
{
position: new google.maps.LatLng(53.593349, -2.296605),

label: {
color: 'black',
fontWeight: 'bold',
text: '14:20',
},

Full Code:

VBA Code: 
Sub GenerateMap()

    Dim c As Range
    Dim FileName As String
    Dim Label As String
    Dim Latitude As String
    Dim Longitude As String
    Dim rng As Range
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Mapping Data")
    Set rng = ws.Range("A2:C" & ws.Cells(Rows.Count, "A").End(xlUp).Row)
    
    If rng.Columns.Count < 2 Then
        MsgBox "You need to have at least 2 columns;(1) the latitude and (2) the longitude.", vbCritical + vbOKOnly
        Exit Sub
    End If
   
    If rng.Columns.Count > 3 Then
        MsgBox "You can't highlight more than 3 columns; (1) the latitude, (2) the longitude, and (3) a label.", vbCritical + vbOKOnly
        Exit Sub
    End If
   
    FileName = Environ("Temp") & "\Google Maps.html"
    
    Latitude = Trim(rng.Cells(1, 1).Text)
    Longitude = Trim(rng.Cells(1, 2).Text)

    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: 10,"
    Print #1, "    center: new google.maps.LatLng(" + Latitude + ", " + Longitude + ")"
    Print #1, "  };"
    Print #1, ""
    Print #1, "  var map = new google.maps.Map(document.getElementById('map-canvas'), mapOptions);"
       
    For Each c In ws.Range("A2:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row)
        Latitude = Trim(Cells(c.Row, "A").Text)
       
        If IsNumeric(Latitude) = False Then
            MsgBox "The latitude in cell " & Cells(c.Row, "A").Address & " needs to be numeric.", vbCritical + vbOKOnly
            Close #1
            Exit Sub
        End If

        Longitude = Trim(Cells(c.Row, "B").Text)
       
        If IsNumeric(Longitude) = False Then
            MsgBox "The longitude in cell " & Cells(c.Row, "B").Address & " needs to be numeric.", vbCritical + vbOKOnly
            Close #1
            Exit Sub
        End If
       
        If rng.Columns.Count = 3 Then
            Label = Trim(Cells(c.Row, "C").Text)
        Else
            Label = "Marker " + CStr(c.Row)
        End If
       
        Print #1, ""
        Print #1, "  var marker" + CStr(c.Row) + "= new google.maps.Marker("
        Print #1, "  {"
        Print #1, "    position: new google.maps.LatLng(" + Latitude + ", " + Longitude + "),"
        Print #1, "    title: " + Chr$(34) + Label + ": (" + Latitude + ", " + Longitude + ")" + _
    "\nDrag this marker to get the latitude and longitude at a different location." + _
    Chr$(34) + ","
        Print #1, "    draggable: false,"
        Print #1, "    map: map"
        Print #1, "  });"
        Print #1, ""
        Print #1, "  google.maps.event.addListener(marker" + CStr(c.Row) + _
        ", 'dragend', function(event)"
        Print #1, "  {"
        Print #1, "    var Title = marker" + CStr(c.Row) + ".getTitle();"
        Print #1, "    var SubStrings = Title.split(" + Chr$(34) + "\n" + Chr$(34) + ");"
        Print #1, "    marker" + CStr(c.Row) + ".setTitle(SubStrings[0] + " + _
    Chr$(34) + "\n" + Chr$(34) + " + "; Chr$(34) + _
    "The latitude and longitude at this location is: " + Chr$(34) + " + marker" + _
    CStr(c.Row) + ".getPosition().toString());"
        Print #1, "  });"
   
    Next c
   
    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:=True

End Sub

Sample data from my file:

LatitudeLongitudeTime StampStatusComments
53.463058-2.2913414:00VCA
53.468979-2.3723714:10GDRABC123
53.593349-2.29660514:20GDR
53.593349-2.34270814:30VCA123ABC

Is anyone able to assist please?

Thanks
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Take a look at the infowindow property in the Google Maps API
 
Upvote 0
That looks great thanks. Only problem is I know very little about html, but will have a look to see what I might be able to do with this.
 
Upvote 0
Well the Google Maps API is interfaced with using javascript and displayed using a browser, html and javascript for dynamic changes/updates.
 
Upvote 0
Hi, so I have got a bit further with this and now have more of a vba issue than anything to do with Google maps.

My code below takes the input from a html file and merges with the lat longs from my data sheet but when attempting to create a new html file I get a "Bad file mode" warning on the Write #1, allText

VBA Code: 
Global LatLongs As String

Sub ConstructLatLongList()

    Dim c As Range
    Dim wsht As Worksheet
    Dim lr As Long
    Dim Latitude, Longitude As String

    Set wsht = ThisWorkbook.Sheets("Mapping Data")

    lr = wsht.Cells(Rows.Count, "A").End(xlUp).Row
    LatLongs = "var locations = [" & vbNewLine

    For Each c In wsht.Range("A2:A" & lr)
        Latitude = Cells(c.Row, "A").Value
        Longitude = Cells(c.Row, "B").Value

        LatLongs = LatLongs & "      ['" & Format(Cells(c.Row, "C"), "hh:mm") & " - " & Cells(c.Row, "D") & "', " & _
                   Latitude & ", " & Longitude & "],"

        If c.Row <> lr Then
            LatLongs = LatLongs & vbNewLine
        End If
    Next c

    LatLongs = Left(LatLongs, Len(LatLongs) - 1)

    'Debug.Print LatLongs

End Sub

Sub CreateHtmlFile()

    Dim text As String, allText As String
    Dim lineNumber As Integer

    ' Open read handle.
    Open "C:\users\me\desktop\new 2.html" For Input As #1

    allText = ""
    lineNumber = 0

    Do Until EOF(1)
        lineNumber = lineNumber + 1
        Line Input #1, text
        allText = allText & vbCrLf & text
        'Debug.Print allText
    Loop
    
    Call ConstructLatLongList
    
    allText = Replace(allText, "var locations = [", LatLongs, 1, , vbTextCompare)

    ' Close read handle.
    Close #1

    ' Output the new text to a separate file.
    Open "C:\users\me\desktop\newmap.html" For Input As #1

    Write #1, allText
    Close #1

End Sub

My original html file looks like:

Rich (BB code): 
<!DOCTYPE html>
<html> 
<head> 
  <meta http-equiv="content-type" content="text/html; charset=UTF-8" /> 
  <title>Google Maps Multiple Markers</title> 
  <script src="http://maps.google.com/maps/api/js?key=MY_API_KEY=initMap"></script>
  <script src="http://ajax.aspnetcdn.com/ajax/jQuery/jquery-1.10.1.min.js"></script>
</head> 
<body>
  <h3>My First Map </h3>
  <body bgcolor="#9fb3f5">    
  <div id="map" style="width: 100%; height: 550px;"></div>

  <script type="text/javascript">

    //var image = 'http://maps.google.com/mapfiles/kml/pushpin/red-pushpin.png'

    var image = 'output-onlinepngtools.png'   

    var locations = [
    ];

    var map = new google.maps.Map(document.getElementById('map'), {
      zoom: 25,
      mapTypeId: google.maps.MapTypeId.ROADMAP  
    });

    var infowindow = new google.maps.InfoWindow();

    var marker, i;
    var markers = new Array();

    for (i = 0; i < locations.length; i++) {  
      marker = new google.maps.Marker({
        position: new google.maps.LatLng(locations[1], locations[2]),
        icon: image,
        map: map
      });

      markers.push(marker);

      google.maps.event.addListener(marker, 'click', (function(marker, i) {
        return function() {
          infowindow.setContent(locations[0]);
          infowindow.open(map, marker);
        }
      })(marker, i));
    }

    function AutoCenter() {
      //  Create a new viewpoint bound
      var bounds = new google.maps.LatLngBounds();
      //  Go through each...
      $.each(markers, function (index, marker) {
      bounds.extend(marker.position);
      });
      //  Fit these bounds to the map
      map.fitBounds(bounds);
    }
    AutoCenter();

  </script> 
</body>
</html>


This should then output the following

Rich (BB code): 
<!DOCTYPE html>
<html> 
<head> 
  <meta http-equiv="content-type" content="text/html; charset=UTF-8" /> 
  <title>Google Maps Multiple Markers</title> 
  <script src="http://maps.google.com/maps/api/js?key=MY_API_KEY&callback=initMap"></script>
  <script src="http://ajax.aspnetcdn.com/ajax/jQuery/jquery-1.10.1.min.js"></script>
</head> 
<body>
  <h3>My First Map </h3>
  <body bgcolor="#9fb3f5">  
  <div id="map" style="width: 100%; height: 550px;"></div>

  <script type="text/javascript">

    //var image = 'http://maps.google.com/mapfiles/kml/pushpin/red-pushpin.png'

    var image = 'output-onlinepngtools.png'   

    var locations = [
      ['14:00 - VCA', 53.463058, -2.29134],
      ['14:10 - GDR', 53.468979, -2.37237],
      ['14:20 - GDR', 53.593349, -2.296605],
      ['14:40 - VCA', 53.610592, -2.342708]
    ];

    var map = new google.maps.Map(document.getElementById('map'), {
      zoom: 25,
      //center: new google.maps.LatLng(51.530616, -0.123125),
      //center: new google.maps.LatLng(52.495222, -2.027895),
      mapTypeId: google.maps.MapTypeId.ROADMAP  
    });

    var infowindow = new google.maps.InfoWindow();

    var marker, i;
    var markers = new Array();

    for (i = 0; i < locations.length; i++) {  
      marker = new google.maps.Marker({
        position: new google.maps.LatLng(locations[1], locations[2]),
        icon: image,
        map: map
      });

      markers.push(marker);

      google.maps.event.addListener(marker, 'click', (function(marker, i) {
        return function() {
          infowindow.setContent(locations[0]);
          infowindow.open(map, marker);
        }
      })(marker, i));
    }

    function AutoCenter() {
      //  Create a new viewpoint bound
      var bounds = new google.maps.LatLngBounds();
      //  Go through each...
      $.each(markers, function (index, marker) {
      bounds.extend(marker.position);
      });
      //  Fit these bounds to the map
      map.fitBounds(bounds);
    }
    AutoCenter();

  </script> 
</body>
</html>
 
Upvote 0
Change:
VBA Code: 
Open "C:\users\me\desktop\newmap.html" For Input As #1 
Write #1, allText
To:
VBA Code: 
    Open "C:\users\me\desktop\newmap.html" For Output As #1
    Print #1, allText
(Write # puts quotes around string variables)
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,214,645
Messages
6,120,711
Members
448,984
Latest member
foxpro

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top