程序代码：

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
'事件，NODE 展开时发生

Static 防止循环 As Boolean                  '防止事件递归调用造成死循环变量

If Not 防止循环 Then                        '如果前一个事件处理没有进行，则继续'
    防止循环 = True                         '设置目前正在处理事件，防止再次进入事件处理
    
    Dim nodx As Node
    
    Set nodx = Node.FirstSibling            '引用同级第一个
    Do While Not nodx Is Node               '当 搜索到的不等于单击的，循环
        nodx.Expanded = False               '收起
        Set nodx = nodx.Next                '引用下一个
    Loop
    
    Set nodx = Node.LastSibling             '引用同级最后一个
    Do While Not nodx Is Node               '当 搜索到的不等于单击的，循环
        nodx.Expanded = False               '收起
        Set nodx = nodx.Previous            '引用上一个
    Loop
    
    Node.Expanded = True                    '本身为展开
    
    DoEvents                                '以确保操作完成
    防止循环 = False                        '事件处理完成，设置标志
End If
End Sub