Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
test d3 module
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.