Deprecated
Google has now stopped its Earth API and Maps API is a paid for API nowadays. Some capabilities have also been either removed or changed. Therefore, I had to remove all examples of VizMap applications I had created. I didn’t remove the entire topic as I thought some of the code may still be useful with some modifications.
VizMap: the common vba for setting up parameter sheets
This relates to Data Driven Mapping applications
For this example I had created a Concerts/Venues example that is now deprecated. The complete workbook (googlemapping.xlsm) can be downloaded (above) and the example Parameter WorkSheet is called VenuesParameters.
Setting up the parameter sheets
All VizMap modules start with setting up all the parameter blocks that will be needed. All these common procedures are in the MapPublics module, along with the names of the parameter blocks that are going to be used. I also register the name of application parameter sheets as constants here so I can refer to them in other modules – note that the name of the parameter sheet for cVizAppVenues is defined here. There are also some other common procedures used in geoCoding etc in this module. The key procedure here though is dSetsSetup which sets up all the parameter blocks according to the selected parameter sheet.
This is called at the beginning of a procedure which will be using these structures as follows, and from then on all access to the parameters in the workbook is ‘abstracted’ meaning that the physical locations or dimensions in the workbook do not need to be known as they can be accessed from the dSets Collection by the name referred to in the list of constants.
Dim dSets As cDataSets Set dSets = dSetsSetup(paramName) If dSets Is Nothing Then Exit Sub
other modules read additional data the same way, for example, this will get the extra parameter blocks needed to generate a vizMap application
vizdSetsSetup paramName, dSets
The full code of the MapPublics module
Option Explicit 'for more about this ' https://ramblings.mcpher.com/classes/datamanip/ 'to contact me ' https://gitter.im/desktopliberation/community 'reuse of code ' https://ramblings.mcpher.com/reusing-code-from-this-site/ Public Enum eOutputMarkers eOutputHtml = 1 eOutputKML = 2 End Enum Public Const cVizAppOrders = "OrdersParameters" Public Const cVizAppVenues = "VenuesParameters" Public Const cVizAppPalaces = "PalacesParameters" Public Const cVizAppOrg = "OrgParameters" Public Const cVizAppFamily = "FamilyParameters" Public Const cFieldID = "ID" Public Const cFieldAddress = "Address" Public Const cFieldValue = "Column Name" Public Const cParamSheet = "Parameters" Public Const cParamFields = "Fields" Public Const cParamRules = "Column Name" Public Const cColumnName = "Column Name" Public Const cTransactions = "Transactions" Public Const cMaster = "Master" Public Const cCopyFields = "Clone" Public Const cCloneFrom = "Clone From" Public Const cJoin = "Join" Public Const cTab = "Tabs" Public Const cMeasure = "Measures" Public Const cName = "Name" Public Const cSheet = "Worksheet" Public Const cBingParameters = "Bing" Public Const cYahooParameters = "Yahoo" Public Const cMarkers = "Markers" Public Const cMarkerHtml = "Marker Html" Public Const cYahooMarkerHtml = "Yahoo Marker Html" Public Const cOviMarkerHtml = "Ovi Marker Html" Public Const cBingMarkerHtml = "Bing Marker Html" Public Const cMarkerViz = "Viz Marker Html" Public Const cMarkerKML = "Marker KML" Public Const cMapTableHtml = "Marker Html" Public Const cMatch = "Matching Column" Public Const cOperation = "Operation" Public Const cChartFields = "Chart Fields" Public Const cFilterFields = "Filter Fields" Public Const cDictionary = "Dictionary" Public Const cTableFields = "Table Fields" Public Const cTwitterFields = "Twitter Fields" Public Const cElement = "Element" Public Const cPosition = "Position" Public Const cShow = "Show" Public Const cGeoCodingParameters = "GeoCodingParameters" Public Const cImage = "Image" Public Const cSpecificViz = "Viz Html" Public Const cControl = "Control" Public Const cLocalControl = "LocalControl" Public Const cControlValue = "Setting" Public Const cEarthMarker = "Earth Marker" Public Const cMapsMarker = "Maps Marker" Public Const cSpots = "Spots" Public Const cChartType = "Chart Type" Public iDebug As Long Public Function dSetsSetup(paramName As String) As cDataSets Dim dSets As cDataSets ' populate the customer master Set dSets = New cDataSets With dSets .create ' get the names of all the sheets .init wholeSheet(paramName), , cName, True, cName ' create the parameter page deserialization data set .init wholeSheet(cGeoCodingParameters), , cParamRules, True, cParamRules .init wholeSheet(cGeoCodingParameters), , cControl, True, cControl .init wholeSheet(.DataSet(cName, True).Cell(cMaster, cSheet).toString), , cMaster, True, , True .init wholeSheet(.DataSet(cName).Cell(cJoin, cSheet).toString), , cJoin, , , True ' create the parameter page data set .init wholeSheet(paramName), , cParamFields, True, cParamFields .init wholeSheet(cGeoCodingParameters), , cBingParameters, True, cBingParameters .init wholeSheet(cGeoCodingParameters), , cYahooParameters, True, cYahooParameters .init wholeSheet(cGeoCodingParameters), , cMarkers, True, cMarkers .init wholeSheet(cGeoCodingParameters), , cMarkerHtml, True, cMarkerHtml .init wholeSheet(cGeoCodingParameters), , cYahooMarkerHtml, True, cYahooMarkerHtml .init wholeSheet(cGeoCodingParameters), , cOviMarkerHtml, True, cOviMarkerHtml .init wholeSheet(cGeoCodingParameters), , cBingMarkerHtml, True, cBingMarkerHtml .init wholeSheet(cGeoCodingParameters), , cMarkerKML, True, cMarkerKML With .DataSet(cParamFields) ' check that the required fields are present in the input data If Not dSets.DataSet(cMaster).HeadingRow.Validate(True, _ .Cell(cFieldID, cFieldValue).toString, _ .Cell(cFieldAddress, cFieldValue).toString) Then Exit Function End If End With End With Set dSetsSetup = dSets End Function Public Sub fullkeySuitableJob(job As cJobject, dr As cDataRow, _ spComponent As String, spSpecial As String, _ Optional rDebug As Range = Nothing) 'given a row, find the most appropriate object to populate it with Dim dc As cCell, pc As cCell, jo As cJobject, sName As String For Each dc In dr.Columns ' is this an interesting column ? sName = dr.Parent.Headings(dc.Column).toString With dr.Parent.Parent.DataSet(cParamRules) Set pc = .Cell(sName, 1) If Not pc Is Nothing Then ' it is a cell that needs filling in Set jo = fullkeyMappingFind(job, _ LCase(.Cell(sName, spComponent).toString), _ LCase(.Cell(sName, spSpecial).toString), _ rDebug) With dc If jo Is Nothing Then .Value = Empty Else .Value = jo.Value End If .Commit End With End If End With Next dc End Sub Public Function fullkeyMappingFind(job As cJobject, _ sComponent As String, sSpecial As String, _ Optional rDebug As Range = Nothing) As cJobject ' given a column name, what's the best fit in the structure response from geocoding Dim sValue As String, jo As cJobject, jResult As cJobject, sKey As String Dim st As String ' these are the parameters we will work with sKey = LCase(job.fullKey) sValue = LCase(job.toString) ' if you need a list this will show all seen api response values If Not rDebug Is Nothing Then rDebug.Offset(iDebug, 0).Value = sKey rDebug.Offset(iDebug, 1).Value = job.Value iDebug = iDebug + 1 End If If sSpecial = "fullkey" Then ' fullkey needs no further matching If sKey = sComponent Then Set fullkeyMappingFind = job Exit Function End If Else MsgBox ("Only full key implemented for this provider") End If ' recurse for children If job.hasChildren Then For Each jo In job.Children Set jResult = fullkeyMappingFind(jo, sComponent, sSpecial, rDebug) If Not jResult Is Nothing Then Set fullkeyMappingFind = jResult Exit Function End If Next jo End If End Function Public Function getTransactionParameters(paramName As String, dSets As cDataSets) As Boolean Dim sId As String With dSets sId = .DataSet(cParamFields).Cell(cFieldID, cFieldValue).toString .init wholeSheet(paramName), , cCopyFields, True, cCopyFields .init wholeSheet(.DataSet(cName).Cell(cTransactions, cSheet).toString), , cTransactions, , , True ' make sure we have an ID field With .DataSet(cTransactions) If Not .HeadingRow.Validate(True, sId) Then Exit Function End If End With End With getTransactionParameters = True End Function Public Sub vizdSetsSetup(paramName As String, dSets As cDataSets) With dSets ' create the parameter page data set cVizSpecifc .init wholeSheet(cGeoCodingParameters), , cMarkerViz, True, cMarkerViz .init wholeSheet(paramName), , cSpecificViz, True, cSpecificViz .init wholeSheet(paramName), , cTab, True, cTab .init wholeSheet(paramName), , cMeasure, True, cMeasure .init wholeSheet(paramName), , cDictionary, True, cDictionary .init wholeSheet(paramName), , cElement, True, cElement .init wholeSheet(paramName), , cSpots, True, cSpots .init wholeSheet(paramName), , cLocalControl, True, cControl End With End Sub Public Function openNewHtml(sName As String, sContent As String) As Boolean Dim handle As Integer handle = getHandle(sName) If (handle <> cFailedtoGetHandle) Then Print #handle, sContent Close #handle openNewHtml = True End If End Function Public Sub addList(jo As cJobject, fstring As String, dr As cDataRow, key As String) Dim a As Variant, i As Long a = Split(dr.Cell(fstring).toString, ",") If UBound(a) >= LBound(a) Then With jo.add(key).AddArray.add For i = LBound(a) To UBound(a) .add , a(i) Next i End With End If End Sub Public Function pickABrowser(dSets As cDataSets, fName As String, _ Optional tell As Boolean = False, _ Optional pControl As String = cControl) As Boolean pickABrowser = True With dSets.DataSet(pControl) Select Case Trim(LCase(.Cell("browser", cControlValue).toString)) Case "default" If Not OpenUrl(fName) Then pickABrowser = False MsgBox ("could not open " & fName & " using default browser") End If Case "none" If tell Then MsgBox (fName & " has been created") Case Default MsgBox ("problem with browser/code parameter in block " & cControl) End Select End With End Function
Questions, feedback and VizMap applications you have generated can be submitted for loading to this site via our forum.
Now let’s look at Vba to join master and transactional data