Vba to generate VizMap Application

VizMap: the vba to generate vizMap application get it now

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.
  1. Load the parameter sheets, dSetsSetup plus the additional framework parameter blocks needed for this phase, vizdSetsSetup
  2. Check that all fields mentioned anywhere in the framework exist in the data, allFieldsPresent
  3. Create a heirarchical cJobject to hold the framework
  4. Add the dictionary, measures, tabs and elements. This is just a translation from cDataSet cells to cJobject nodes.
  5. Now create the cJobject to hold the data
  6. Use the Dictionary object to find the required data in the venuesMapping dataset and add each object and its value
  7. 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.
  8. 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, _
            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 _
                    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 & _
    s2 = "//---Excel generated data" & vbLf & _
         "  function mcpherGetData () " & vbLf & _
          " { return (" & vbLf & joData.Serialize(True) & vbLf & " ) ; }" & vbLf & _

    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)
                            With .DataSet(dataName).HeadingRow
                                If Not .Validate(True, dd.toString) Then Exit Function
                            End With
                        End If
                        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