[已解决]关于Treeview事件。

squallive

Treeview控件，当鼠标经过时条目变成高亮显示，如果该条目存在节点，会自动把下一级节点打开，再点一下鼠标就把该数据提取到SHEET1中。当鼠标离开时还原(节点打开的会自动关闭)，代码要怎样写？







Treeview求助.rar (14.23 KB, 下载次数: 5)

2013-1-25 11:52 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-1-25 13:28

Treeview求助.rar (21.52 KB, 下载次数: 68)

2013-1-25 13:28 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

看了下对象的资料，找到了hitest方法，居然又扯出一个x,y坐标转换。

1. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
   
2. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nindex As Long) As Long
   
3. Private PixX2TwipX As Double '像素转换成缇
   
4. Private PixX2TwipY As Double
   
5. Private Const LOGPIXELSX = 88
   
6. Private Const LOGPIXELSY = 90
   
7. 
   
8. Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
   
9.     Dim node As node
   
10.     Set node = TreeView1.HitTest(x * PixX2TwipX, y * PixX2TwipY)
    
11.     If node Is Nothing Then Exit Sub
    
12.     If node.Children > 0 Then
    
13.         node.Expanded = True
    
14.     End If
    
15. End Sub
    
16. 
    
17. Private Sub UserForm_Initialize()
    
18.     Dim Nodx As node, c1 As String, c2 As String
    
19.     TreeView1.ImageList = ImageList1
    
20.     Set Nodx = TreeView1.Nodes.Add(, , "总公司", "总公司人事结构", 1)
    
21.     With Sheets("数据源")
    
22.         For x = 2 To .Range("B65536").End(xlUp).Row
    
23.             c1 = .Cells(x, 1)
    
24.             c2 = .Cells(x, 2) & ""
    
25.             If Len(c2) = 1 Then
    
26.                 Set Nodx = TreeView1.Nodes.Add("总公司", tvwChild, "A" & c2, c1 & "(" & c2 & ")", 2)
    
27.             ElseIf Len(c2) = 3 Then
    
28.                 Set Nodx = TreeView1.Nodes.Add("A" & Left(c2, 1), tvwChild, "A" & c2, c1 & "(" & c2 & ")", 3)
    
29.             ElseIf Len(Cells(x, 2)) = 6 Then
    
30.                 Set Nodx = TreeView1.Nodes.Add("A" & Left(c2, 3), tvwChild, "A" & c2, c1 & "(" & c2 & ")", 4)
    
31.             End If
    
32.         Next
    
33.     End With
    
34.     PixX2TwipX = Application.InchesToPoints(1) * 20 / GetDeviceCaps(GetDC(0), LOGPIXELSX)
    
35.     PixX2TwipY = Application.InchesToPoints(1) * 20 / GetDeviceCaps(GetDC(0), LOGPIXELSY)
    
36. End Sub

复制代码

hwc2ycy

改了下，当光标离开节点后，自动收缩展开的节点。

1. Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
   
2.     Dim node As node
   
3.     With Me.TreeView1
   
4.         Set node = .HitTest(x * PixX2TwipX, y * PixX2TwipY)
   
5.         If node Is Nothing Then
   
6.             .SelectedItem.Expanded = False
   
7.             Exit Sub
   
8.         End If
   
9.         If node.Children > 0 Then
   
10.             node.Expanded = True
    
11.         End If
    
12.     End With
    
13. End Sub

复制代码

hwc2ycy

单击写入sheet1

1. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
   
2.     Dim level, code
   
3.     Dim iRow&
   
4.     With Node
   
5.         level = .Key
   
6.         code = .Text
   
7.     End With
   
8.     With Worksheets("Sheet1")
   
9.         iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
   
10.         .Cells(iRow, 1) = level
    
11.         .Cells(iRow, 2) = code
    
12.     End With
    
13. End Sub

复制代码

hwc2ycy

防止进入标签编辑状态。

1. Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
   
2.     Cancel = True
   
3. End Sub

复制代码

hwc2ycy

Treeview求助.rar (21.52 KB, 下载次数: 68)

2013-1-25 13:28 上传

点击文件名下载附件

squallive

好像有点问题，鼠标稍微动一下节点就会全部关闭。。还有就是，只想把三级节点和所在的部门导出到SHEET1，其余的不想导出。。

hwc2ycy

squallive 发表于 2013-1-25 14:58
好像有点问题，鼠标稍微动一下节点就会全部关闭。。还有就是，只想把三级节点和所在的部门导出到SHEET1，其 ...

这个自动收缩我之前说过嘛。
至于你要个数据，就在哪个节点上单击就成了。