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

 

下面为实例