[示例六] 控件綜合使用示例(1)
本例根據(jù)puremis.net中的代碼整理,。
在工作表中選擇菜單“視圖”——“工具欄”——“控件工具箱”，使用“圖像”控件添加10個(gè)圖像控件,，分別命名為Image1至Image9,，還有一個(gè)為None。在這些控件中單擊右鍵,，選擇“屬性”并從picture屬性中選擇合適的圖像,。然后，將對(duì)象名稱放置在C1至C11單元格中,。在B2至B11單元格,，放置名字和相應(yīng)的父親的名字，在D列，放置個(gè)人簡(jiǎn)介,。此時(shí),，工作表Sheet1如圖16所示。
 
圖16：工作表中的數(shù)據(jù)
在VBE編輯器中插入一個(gè)用戶窗體,，在其上放置一個(gè)TreeView控件和兩個(gè)文字框控件,，并進(jìn)行相應(yīng)的設(shè)置，如圖17所示,。
 
圖17：設(shè)計(jì)界面,。
TreeView包含TreeNodes的集合，每個(gè)TreeNode對(duì)象都是TreeNode集合的一個(gè)成員,，其編號(hào)按顯示順序從0到Nodes.Count-1,。本例中，沒有使用索引號(hào),，而是關(guān)鍵字,，如：
TreeView1.Nodes.Add(Relative:="The key of Parent", Relationship:=tvwChild, Text:="Your Text")。
在VBE編輯器中插入一個(gè)模塊,，并輸入下面的代碼：
Option Explicit

Sub MakeFamilyTree()
    Dim arrName As Variant
    Dim arrParent As Variant
    Dim arrMatrix() As Variant
    Dim arrTemp As Variant
    Dim elm As Variant
    Dim i As Long, j As Long
    Dim ret As Variant
    Dim node As node
    Dim bExists As Boolean

    '重置TreeView控件
    UserForm1.TreeView1.Nodes.Clear
    
    '從工作表中獲取數(shù)據(jù)作為一個(gè)數(shù)組
    With Sheets("Sheet1").Range(Sheets("Sheet1").[A2], Sheets("Sheet1").[A65536].End(xlUp))
        arrName = .Value
        arrParent = .Offset(, 1).Value
    End With
    
    '排序
    ReDim arrMatrix(1 To UBound(arrName), 1 To 1)
    For Each elm In arrParent
        i = i + 1
        ret = Application.Match(elm, arrName, 0)
        If IsError(ret) Then
            arrMatrix(i, 1) = arrName(i, 1)
        Else
            j = 3
            ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
            arrMatrix(i, 1) = arrName(i, 1)
            arrMatrix(i, 2) = elm
            arrMatrix(i, 3) = arrParent(ret, 1)
            Do
                ret = Application.Match(arrParent(ret, 1), arrName, 0)
                If IsError(ret) Then Exit Do
                If arrParent(ret, 1) = "" Then Exit Do
                j = j + 1
                ReDim Preserve arrMatrix(1 To UBound(arrMatrix), 1 To j)
                arrMatrix(i, j) = arrParent(ret, 1)
            Loop
        End If
    Next
    arrTemp = CustomTranspose(arrMatrix)
    
    '添加數(shù)據(jù)到節(jié)點(diǎn)中
    For i = 1 To UBound(arrTemp)
        For j = 1 To UBound(arrTemp, 2)
            If Not IsEmpty(arrTemp(i, j)) Then
                With UserForm1.TreeView1
                    bExists = False
                    For Each elm In .Nodes
                        If elm = arrTemp(i, j) Then bExists = True
                    Next
                    If Not bExists Then
                        If j = 1 Then
                            Set node = .Nodes.Add(, , arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        Else
                            Set node = .Nodes.Add(arrTemp(i, j - 1), tvwChild, arrTemp(i, j), arrTemp(i, j), _
                            Image:=GetInfo(arrTemp(i, j), True))
                        End If
                        node.Expanded = True
                    End If
                End With
            End If
        Next
    Next
End Sub

Function CustomTranspose(ByVal buf As Variant) As Variant
'轉(zhuǎn)換數(shù)組順序從父節(jié)點(diǎn)到子節(jié)點(diǎn)
    Dim arrTemp() As Variant
    Dim i As Long, j As Long, k As Long
    ReDim arrTemp(LBound(buf) To UBound(buf), LBound(buf, 2) To UBound(buf, 2))
    For i = 1 To UBound(buf)
        k = 0
        For j = UBound(buf, 2) To 1 Step -1
            If Not IsEmpty(buf(i, j)) Then
                k = k + 1
                arrTemp(i, k) = buf(i, j)
            End If
        Next
    Next
    CustomTranspose = arrTemp
End Function

Function GetInfo(sName, bAorD) As String
'返回合適的圖像
    Dim rFound As Range
    Set rFound = Sheet1.Columns(1).Find(sName, lookat:=xlWhole)
    If rFound Is Nothing Then
        GetInfo = "none"
    Else
        GetInfo = IIf(bAorD, rFound.Offset(, 2).Value, rFound.Offset(, 3).Value)
    End If
End Function
在用戶窗體代碼模塊中,，輸入下面的代碼：
Private Sub UserForm_Activate()
    SettingImageList
    MakeFamilyTree
End Sub

Private Sub SettingImageList()
    Dim myImgList As New ImageList
    Dim bt
    With myImgList.ListImages
        .Add Key:="Image1", Picture:=Sheet1.Image1.Picture
        .Add Key:="Image2", Picture:=Sheet1.Image2.Picture
        .Add Key:="Image3", Picture:=Sheet1.Image3.Picture
        .Add Key:="Image4", Picture:=Sheet1.Image4.Picture
        .Add Key:="Image5", Picture:=Sheet1.Image5.Picture
        .Add Key:="Image6", Picture:=Sheet1.Image6.Picture
        .Add Key:="Image7", Picture:=Sheet1.Image7.Picture
        .Add Key:="Image8", Picture:=Sheet1.Image8.Picture
        .Add Key:="Image9", Picture:=Sheet1.Image9.Picture
        .Add Key:="none", Picture:=Sheet1.none.Picture
    End With
    With TreeView1
        Set .ImageList = myImgList
        .Indentation = 14
        .LabelEdit = tvwManual
        .HideSelection = False
    End With
End Sub

Private Sub TreeView1_NodeClick(ByVal node As MSComctlLib.node)
    Me.TextBox1.Text = node.Text
    Me.TextBox2.Text = GetInfo(node.Text, False)
End Sub
運(yùn)行后的結(jié)果如圖18所示。

圖18：運(yùn)行后的結(jié)果