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 vba to generate vizMap application
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.
Generating the application
Generating the application will take the parameter data to create a jSon framework, and the data in the venuesMapping sheet to create the jSon data, and wrap it all up in the predefined javaScript found in the geoCoding parameter sheet, along with the application specific html in the venuesParameter sheet.
vba walkthrough
The code can be found in the vizExamples module.
-
- Load the parameter sheets, dSetsSetup plus the additional framework parameter blocks needed for this phase, vizdSetsSetup
- Check that all fields mentioned anywhere in the framework exist in the data, allFieldsPresent
- Create a heirarchical cJobject to hold the framework
- Add the dictionary, measures, tabs and elements. This is just a translation from cDataSet cells to cJobject nodes.
- Now create the cJobject to hold the data
- Use the Dictionary object to find the required data in the venuesMapping dataset and add each object and its value
- Create an html file, generateVizHtml, which takes each of the code components from the parameter sheets and combines that with a jSon serialization of both the framework and data cJobjects.
- Start up a browser if required and run the generated application pickABrowser dSets, fName
complete vba for vizExamples module
' assume we've geocoded and run the ordersjoining example - this is the input to this '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/ Option Explicit ' application 1 Public Sub vizOrders() googleMarkingViz (cVizAppOrders) End Sub ' application 2 Public Sub vizVenues() googleMarkingViz (cVizAppVenues) End Sub ' application 3 Public Sub vizPalaces() googleMarkingViz (cVizAppPalaces) End Sub ' application 4 Public Sub vizOrg() googleMarkingViz (cVizAppOrg) End Sub ' application 5 Public Sub vizFamily() googleMarkingViz (cVizAppFamily) End Sub Public Sub googleMarkingViz(paramName As String) Dim dSets As cDataSets, dc As cCell, job As cJobject, fName As String Dim dr As cDataRow, jo As cJobject, drtab As cDataRow, joe As cJobject Dim joc As cJobject, a As Variant, i As Long, jod As cJobject Dim eOutput As eOutputMarkers eOutput = eOutputHtml Set dSets = dSetsSetup(paramName) If dSets Is Nothing Then Exit Sub vizdSetsSetup paramName, dSets ' check that we have the required marker fields If Not ( _ allFieldsPresent(dSets, cTab, cTableFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cFilterFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cChartFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cTwitterFields, cJoin, True) And _ allFieldsPresent(dSets, cSpots, cControlValue, cJoin, True) And _ allFieldsPresent(dSets, cDictionary, cMatch, cJoin, , False)) Then Exit Sub ' we have it all now create a job Set job = New cJobject ' create the Tabs With job.init(Nothing, "framework") With .add("dictionary") For Each dr In dSets.DataSet(cDictionary).Rows .add dr.Cell(cDictionary).toString, _ dSets.DataSet(cJoin).Column(dr.Cell(cMatch).toString).googleType Next dr End With End With ' create the frameworl With job With .add("measures") For Each dr In dSets.DataSet(cMeasure).Rows .add dr.Cell(cMeasure).toString, dr.Cell(cOperation).toString Next dr End With With .add("control") For Each dr In dSets.DataSet(cLocalControl).Rows .add dr.Cell(cControl).toString, dr.Cell(cControlValue).toString Next dr End With With .add("tabs") For Each dr In dSets.DataSet(cTab).Rows Set jod = .add(dr.Cell(cTab).toString) addList jod, cFilterFields, dr, "filter" addList jod, cChartFields, dr, "chart" addList jod, cTableFields, dr, "table" addList jod, cTwitterFields, dr, "twitter" jod.add "image", dr.Cell(cImage).toString jod.add "charttype", dr.Cell(cChartType).toString Next dr End With With .add("elements") For Each dr In dSets.DataSet(cElement).Rows With .add(LCase(dr.Cell(cElement).toString)) .add "position", dr.Cell(cPosition).toString .add "show", dr.Cell(cShow).toString End With Next dr End With With .add("spots") For Each dr In dSets.DataSet(cSpots).Rows .add dr.Cell(cSpots).toString, dr.Cell(cControlValue).toString Next dr End With End With ' create the data Set joe = New cJobject With joe.init(Nothing, "data") With .add("cJobject").AddArray For Each dr In dSets.DataSet(cJoin).Rows With .add For Each jo In job.Child("dictionary").Children .add jo.key, dr.Cell( _ dSets.DataSet(cDictionary).Cell(jo.key, cMatch).toString _ ).toString Next jo End With Next dr End With End With ' now create the html file and browse to it fName = dSets.DataSet(cSpecificViz).Cell("filename", "code").toString Select Case eOutput Case eOutputHtml If openNewHtml(fName, generateVizHtml(job, joe, dSets)) Then pickABrowser dSets, fName, , cLocalControl End If Case Else Debug.Assert False End Select Set dSets = Nothing End Sub Private Function generateVizHtml(joFrame As cJobject, joData As cJobject, _ dSets As cDataSets) As String Dim s1 As String, s2 As String ' the deserialized data s1 = "//---Excel generated framework" & vbLf & _ "function mcpherGetFramework () " & vbLf & _ " { return (" & vbLf & joFrame.Serialize(True) & vbLf & " ) ; }" & vbLf & _ "//---ramblings.mcpher.com" s2 = "//---Excel generated data" & vbLf & _ " function mcpherGetData () " & vbLf & _ " { return (" & vbLf & joData.Serialize(True) & vbLf & " ) ; }" & vbLf & _ "//---ramblings.mcpher.com" With dSets.DataSet(cSpecificViz) generateVizHtml = _ .Cell("header", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherinit", "code").toString & vbLf _ & s1 & vbLf & s2 & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcphervizmap", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherinfotab", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpheritem", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherspot", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherearth", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherfunctions", "code").toString & vbLf _ & .Cell("body", "code").toString & vbLf End With End Function Private Function allFieldsPresent(dSets As cDataSets, _ blockName As String, columnName As String, _ dataName As String, Optional allowBlank As Boolean = False, _ Optional useDictionary As Boolean = True) As Boolean Dim dc As cCell, dd As cCell, a As Variant, i As Long, S As String allFieldsPresent = False With dSets For Each dc In .DataSet(blockName).Column(columnName).Rows If (Not allowBlank Or dc.toString <> vbNullString) Then a = Split(dc.toString, ",") For i = LBound(a) To UBound(a) S = a(i) If useDictionary Then Set dd = .DataSet(cDictionary).Cell(S, cMatch) If (dd Is Nothing) Then MsgBox ("cannot find in dictionary " & S & " needed by " & blockName) Else With .DataSet(dataName).HeadingRow If Not .Validate(True, dd.toString) Then Exit Function End With End If Else With .DataSet(dataName).HeadingRow If Not .Validate(True, S) Then Exit Function End With End If Next i End If Next dc End With allFieldsPresent = True 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 VizMap javaScript, the generated application.