Public Sub d3forceHere()
d3ForceDo
End Sub
Public Sub d3ForceDo(Optional wn As String = vbNullString, _
Optional optionName As String = "force options", Optional fieldName As String = "force fields")
Dim w As String
w = wn
If w = vbNullString Then
w = ActiveSheet.name
End If
mashupGeneral "d3allparameters", w, "force", optionName, fieldName
End Sub
Set dsets = New cDataSets
' get all parameters and data
With dsets.create()
With .init(wholeSheet(params), , "fields", True, fieldName)
' validate stuff
links = Split(.cell("links", "value").toString, ",")
groups = Split(.cell("groups", "value").toString, ",")
names = Split(.cell("names", "value").toString, ",")
count = .cell("count", "value").toString
styleColumn = .cell("styleColumn", "value").toString
linkName = .cell("linkName", "value").toString
labels = Split(.cell("count", "value").toString, ",")
If arrayLength(labels) < 1 Then
labels = names
End If
End With
Set nodesLink = New cNodesLinks
nodesLink.init .init( _
wholeSheet(params), , "options", True, optionName)
.init wholeSheet(params), , item, True, item
With .init(wholeSheet(data), , "data", , , True)
' check everything exists
Debug.Assert dsValidateHeadings(.headingRow, links)
Debug.Assert dsValidateHeadings(.headingRow, groups)
Debug.Assert dsValidateHeadings(.headingRow, labels)
If count <> vbNullString Then Debug.Assert _
.headingRow.validate(True, count)
If styleColumn <> vbNullString Then Debug.Assert _
.headingRow.validate(True, styleColumn)
If linkName <> vbNullString Then Debug.Assert _
.headingRow.validate(True, linkName)
For Each dr In .rows
' add the nodes
For i = LBound(links) To UBound(links)
nodesLink.addNode _
fixup(dr, links(i)), _
fixup(dr, groups(i)), _
fixup(dr, labels(i)), _
fixup(dr, count)
Next i
' make the links
For i = LBound(links) To UBound(links) - 1
nodesLink.addLink _
dr.cell(links(i)).toString, _
dr.cell(links(i + 1)).toString, _
fixup(dr, count), _
fixup(dr, styleColumn), _
fixup(dr, linkName)
Next i
Next dr
' generate a d3.js force chart
mashD3Force dsets.dataSet(item), nodesLink.jObject, dsets.dataSet("fields")
Now that we have the nodeLinks structure, and all the options we can serialize the data and options, and create the web page
js = job.serialize
With dsParam
content = content & _
.cell("titles", "value").toString
content = content & _
.cell("styles", "value").toString
If Not dsFields Is Nothing Then
With dsFields.cell("linkStyles", "value")
If .toString <> vbNullString Then
content = content & "<style>" & _
.toString & _
"</style>"
End If
End With
End If
content = content & _
.cell("code", "value").toString
content = content & _
"<script> var mcpherTreeData = " & js & ";</script></head><body><div>"
content = content & _
.cell("banner", "value").toString
If Not dsFields Is Nothing Then
With dsFields.cell("banner", "value")
If .toString <> vbNullString Then
content = content & .toString
End If
End With
End If
content = content & _
.cell("body", "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
For the cNodesLinks object see the cDataSet.xlsm workbook.
bruce mcpherson is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License. Based on a work at http://www.mcpher.com. Permissions beyond the scope of this license may be available at code use guidelines