VizMap: the vba to generate vizMap application get it now
This relates to Data Driven Mapping applications
For this example we are going to use the Concerts/Venues example. The complete workbook (googlemapping.xlsm) can be downloaded 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
' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
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