vba treeview动态生成，及递归选中checkbox
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Sheet1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Dim nodeinfo() As String
Dim tc As New treeControl
Sub start()
ReDim Preserve nodeinfo(10)
nodeinfo(0) = "1-1,v1,1"
nodeinfo(1) = "1-2,v2,2"
nodeinfo(2) = "1-1-1,v1b1,11"
nodeinfo(3) = "1-1-2,v1b2,12"
nodeinfo(4) = "1-2-1,v2b1,21"
nodeinfo(5) = "1-2-2,v2b2,22"
nodeinfo(6) = "1-2-2-1,v2b2c1,221"
nodeinfo(7) = "1-2-2-2,v2b2c2,222"
nodeinfo(8) = "1-1-1-1,v1b1c1,111"
nodeinfo(9) = "1-1-2-1,v1b2c1,121"
'启动生成
Call createTree(nodeinfo)
'下面为测试不需要关心
Debug.Print tc.getNodeinfoId(nodeinfo, "v1b1")
Debug.Print tc.getNodeDepth(nodeinfo)(0)
Dim depath As String
depath = tc.getNodeDepth(nodeinfo)(0)
Debug.Print tc.getNodeInfoText(nodeinfo, depath)
Dim nodeSplit() As String
nodeSplit = Split("1-1-2", "-")
Debug.Print tc.getBeforeDepath(nodeSplit)
End Sub
'生成树
Sub createTree(nodeinfo() As String)
Dim nodeDepath() As String
nodeDepath = tc.getNodeDepth(nodeinfo)
Call init
For i = 0 To UBound(nodeDepath) - 1
Dim nodeSplit() As String
nodeSplit = Split(nodeDepath(i), "-")
If (UBound(nodeSplit) = 1) Then
addchildnode "netlab", tc.getNodeInfoText(nodeinfo, nodeDepath(i))
Else
addchildnode tc.getNodeInfoText(nodeinfo, tc.getBeforeDepath(nodeSplit)), tc.getNodeInfoText(nodeinfo, nodeDepath(i))
End If
Next
'展开根节点
myTree.Nodes(1).Expanded = True
'选中所有
End Sub
'增加节点，参数1:上一级节点的text;参数2:本节点的text
Private Sub addchildnode(nodeText As String, Text As String)
myTree.Nodes.add nodeText, tvwChild, Text, Text
End Sub
'初始化树，清空树，并创建第一级节点
Private Sub init()
myTree.Nodes.Clear
myTree.Nodes.add , , "netlab", "netlab"
End Sub
'***********************************************************
'*TreeView操作
'***********************************************************
'递归调用示例
Private Sub myTree_NodeCheck(ByVal Node As MSComctlLib.Node)
Dim i As Long
Dim NodX As Node
Set NodX = Node
'如果子节点被干掉，则上溯至顶层节点的所有父节点都被干掉
Do While NodX.Root <> NodX
If Not NodX.Checked Then
NodX.Parent.Checked = False
End If
Set NodX = NodX.Parent
Loop
'使用递归，把该节点的字节点都选中或不选
If Node.Children > 0 Then
For i = Node.Child.FirstSibling.Index To Node.Child.LastSibling.Index
myTree.Nodes.Item(i).Checked = Node.Checked
Call myTree_NodeCheck(myTree.Nodes.Item(i))
Next i
End If
Set NodX = Nothing
End Sub
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "treeControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'根据节点text返回节点ID
Public Function getNodeinfoId(nodeinfo() As String, nodeText As String)
For i = 0 To UBound(nodeinfo) - 1
If (Split(nodeinfo(i), ",")(1) = nodeText) Then
getNodeinfoId = CInt(Split(nodeinfo(i), ",")(2))
End If
Next
End Function
'根据节点的深度返回节点的Text
Public Function getNodeInfoText(nodeinfo() As String, nodeDepath As String)
For i = 0 To UBound(nodeinfo) - 1
If (Split(nodeinfo(i), ",")(0) = nodeDepath) Then
getNodeInfoText = Split(nodeinfo(i), ",")(1)
End If
Next
End Function
'分析数组，并返回深度数组
Public Function getNodeDepth(nodeinfo() As String)
Dim nodeDepath() As String
For i = 0 To UBound(nodeinfo) - 1
ReDim Preserve nodeDepath(i + 1)
nodeDepath(i) = Split(nodeinfo(i), ",")(0)
Next
getNodeDepth = nodeDepath
End Function
'根据节点深度，返回上一级节点深度
Public Function getBeforeDepath(nodeSplit() As String)
Dim retrunDepath As String
For i = 0 To UBound(nodeSplit) - 1
retrunDepath = retrunDepath + CStr(nodeSplit(i)) + "-"
Next
getBeforeDepath = Left(retrunDepath, Len(retrunDepath) - 1)
End Function
下面为实例