test d3 module

testsankey.vba

Option Explicit
'v2.0
Public Sub testSan()
    Dim ds As New cDataSet, cs As New cSankey, dsParam As New cDataSet, _
        js As String, content As String, co As cJobject, dop As cDataSet
    
    Dim UA As cUAMeasure
    Set UA = registerUA("d3Sankey")
    
    Set dop = New cDataSet
    dop.populateData wholeSheet("sankeyparameters"), , , True, "sankey options"
    ' generate a sankey chart from excel data
    With dsParam.populateData(wholeSheet("sankeyparameters"), , , True, "Item", , True)
        ' get data values as json
        
        js = cs.init(ds.populateData(ActiveSheet.Cells, , , , , , True), dop, , _
                .isCellTrue("inheritNodeColor", "value"), _
                .isCellTrue("inheritLinkColor", "value"), _
                .value("linkopacity", "value", False), _
                .value("linkurl", "value", False), _
                .value("nodeurl", "value", False) _
                ).json
        
        content = .cell("titles", "value").toString
        content = content & _
            .cell("defaultStyles", "value").toString
        content = content & _
            .cell("sankeyStyles", "value").toString
        content = content & _
            .cell("header", "value").toString
        content = content & _
            .cell("sankeyCode", "value").toString
        content = content & _
            "<script> var mcpherSankeyData = " & js & ";</script>"
        content = content & _
            .cell("chartCode", "value").toString
            
        With .cell("htmlname", "value")
            openNewHtml .toString, content
            If Not OpenUrl(.toString) Then
                MsgBox ("could not open " & .toString & " using default browser")
            End If
        End With
        cs.jObject.teardown
        .teardown
        ds.teardown
    
    End With
    UA.postAppKill.teardown
End Sub
Public Sub testThisPartition()
    makeD3Partition "d3treeparameters"
End Sub
Public Sub makeD3Partition(params As String, Optional sn As String = vbNullString, _
        Optional banner As String = vbNullString)
    Dim data As String, dsParam As New cDataSet, dsOptions As New cDataSet, js As String
    Dim content As String, t As String
    Dim UA As cUAMeasure
    Set UA = registerUA("D3Partition" & params & "_" & sn & "_" & banner)
    data = sn
    If (data = vbNullString) Then data = ActiveSheet.name
    ' make a d3 partition chart - data is same format as d3 tree
    js = getTreeAsJson(params, data, dsOptions, dsParam, "partition", "partition options")
    ' construct the executable file and call the browser
    content = ""
    With dsParam
        If banner = vbNullString Then
            t = .cell("banner", "value").toString
        Else
            t = banner
        End If
        content = content & _
            .cell("titles", "value").toString
        content = content & _
            .cell("styles", "value").toString
        content = content & _
            .cell("code start", "value").toString
        content = content & _
            "var mcpherTreeData = " & js & ";"
        content = content & _
            .cell("code", "value").toString
        content = content & _
            t
        content = content & _
            .cell("body", "value").toString

        makeAndOpen .cell("htmlname", "value").toString, content
    
    End With
    UA.postAppKill.teardown
    
End Sub
Private Function makeAndOpen(fn As String, content As String, Optional complain As Boolean = True) As Boolean
    
    openNewHtml fn, content
    If Not OpenUrl(fn) Then
        If (complain) Then MsgBox ("could not open " & fn & " using default browser")
        makeAndOpen = False
    Else
        makeAndOpen = True
    End If
    
End Function
Public Sub testD3Tree()
    makeD3Tree "d3treeparameters", "d3tree"
End Sub
Public Sub testThisD3Tree()
    makeD3Tree "d3treeparameters", ActiveSheet.name
End Sub

Private Function getTreeAsJson(params As String, data As String, dsOptions As cDataSet, _
                 dsParam As cDataSet, item As String, options As String) As String
    Dim cj As New cJobject, ds As New cDataSet, c As cJobject
    
    ' get parameters
    dsParam.populateData wholeSheet(params), , , True, item
    dsOptions.populateData wholeSheet(params), , , True, options
    ' get data values as json

    getTreeAsJson = cj _
        .init(Nothing) _
        .makeD3Tree(ds.populateData(wholeSheet(data), , , , , , True), _
           dsOptions, options) _
        .serialize
    Set cj = Nothing
    Set ds = Nothing

End Function

Public Sub makeD3Tree(params As String, data As String, Optional banner As String = vbNullString)
    Dim dsOptions As New cDataSet
    Dim cs As New cSankey, dsParam As New cDataSet, _
        js As String, content As String, t As String
        
    Dim UA As cUAMeasure
    Set UA = registerUA("makeD3Tree_" & params & "_" & banner)
    ' generate a d3.js Tree chart from excel data
    js = getTreeAsJson(params, data, dsOptions, dsParam, "item", "options")
        
    ' construct the executable file and call the browser
    content = ""
    With dsParam
        If banner = vbNullString Then
            t = .cell("banner", "value").toString
        Else
            t = banner
        End If
        content = content & _
            .cell("titles", "value").toString
        content = content & _
            .cell("styles", "value").toString
        content = content & _
            .cell("code", "value").toString
        content = content & _
            "<script> var mcpherTreeData = " & js & ";</script></head><body><div>"
        content = content & _
            t
        content = content & _
            .cell("body", "value").toString
        
        makeAndOpen .cell("htmlname", "value").toString, content
    
    End With
    UA.postAppKill.teardown

End Sub