Excel Macros - Plot locations on Google map using VBA and Import updated map to Excel

[ashish]

If you want to show or plot your office location/delivery centers on Google Map and Import the updated map to Excel. Snapshot below-

 

 

Download the working file here  https://www.box.com/s/p3c38e3nlqqpfob7uo9h

• Go to “Data” sheet and add new locations which you want to plot on map .
• Choose marker color and size
• Click on update map button to import updated map to Excel

To know more about marker color types and sizes visit

https://developers.google.com/maps/documentation/staticmaps/#Markers

Below is the code used to import the updated map from Google to Excel. Add it to the new module

Sub update_maps()
‘Get google map check Google Map API
‘https://developers.google.com/maps/documentation/staticmaps/
‘I have taken Static Map Google
‘

Dim mapurl As String, z As String
Dim i As Long

‘ map types
‘roadmap (default) specifies a standard roadmap image, as is normally shown on the Google Maps website. If no maptype value is specified, the Static Maps API serves roadmap tiles by default.
‘satellite specifies a satellite image.
‘terrain specifies a physical relief map image, showing terrain and vegetation.
‘hybrid specifies a hybrid of the satellite and roadmap image, showing a transparent layer of major streets and place names on the satellite image.

mapurl = “http://maps.googleapis.com/maps/api/staticmap?size=640×640&maptype=terrain”

For i = 2 To Sheets(“Data”).Range(“d65356″).End(xlUp).Row
z = z & “&markers=size:” & Sheets(“Data”).Cells(i, 5).Value & “%7Ccolor:” & Sheets(“Data”).Cells(i, 6).Value & “%7C” & Application.WorksheetFunction.Substitute(Sheets(“Data”).Cells(i, 1).Value, ” “, “+”) & “,” & _
Application.WorksheetFunction.Substitute(Sheets(“Data”).Cells(i, 2).Value, ” “, “+”) & “,” & _
Application.WorksheetFunction.Substitute(Sheets(“Data”).Cells(i, 3).Value, ” “, “+”) & “,” & _
Application.WorksheetFunction.Substitute(Sheets(“Data”).Cells(i, 4).Value, ” “, “+”) & “,”
Next

mapurl = mapurl & z & “&sensor=false”
‘MsgBox mapurl

Call insert_image(mapurl, Sheets(“map”))

Sheets(“map”).Activate

End Sub

Sub insert_image(url As String, wk As Worksheet)

Dim sh As Shape

For Each sh In wk.Shapes
sh.Delete
Next
wk.Range(“a1″).Parent.Pictures.Insert url

Set sh = wk.Shapes(1)
sh.Left = wk.Range(“a1″).Left
sh.Top = wk.Range(“a1″).Top

End Sub

 

Download working file https://www.box.com/s/p3c38e3nlqqpfob7uo9h