[已解决]请hwc2ycy师帮忙解决。谢谢！

c888

谢谢hwc2ycy师再帮忙看下。谢谢！
2（4级）.zip (25.55 KB, 下载次数: 13)

2013-8-21 16:46 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-8-21 18:17

1. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
   
2.     Dim sql$, I%, r%
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     Set rst = CreateObject("ADODB.Recordset")
   
5.     With Sheets("Sheet3")
   
6.         r = .Range("a65536").End(xlUp).Row
   
7.     End With
   
8.     cnn.Open "Provider =Microsoft.Jet.OLEDB.4.0;Extended properties= Excel 8.0;Data source=" & ThisWorkbook.FullName
   
9.     With TreeView1
   
10.         For I = 1 To .Nodes.Count
    
11.             If .Nodes(I).Children = 0 Then
    
12.                 If .Nodes(I).Selected Then
    
13.                     .Nodes(I).Image = 4
    
14.                 Else
    
15.                     .Nodes(I).Image = 3
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.     End With
    
20. 
    
21.     On Error GoTo errorhandler
    
22.     sql = "select * from [sheet3$a2:w" & r & "]"
    
23.     Select Case UBound(Split(Node.FullPath, "")) + 1
    
24.         Case 1:
    
25.         Case 2:
    
26.             sql = sql & "  where 名称 = '" & Node.Text & "'"
    
27.         Case 3:
    
28.             sql = sql & "  where 班级 = '" & Node.Text & "'"
    
29.         Case 4:
    
30.             sql = sql & "  where 姓名 = '" & Node.Text & "'"
    
31.     End Select
    
32.    
    
33.     rst.Open sql, cnn, 3, 1
    
34.     If rst.RecordCount = 0 Then MsgBox "未找到记录！", vbInformation, "友情提示": Exit Sub
    
35.    
    
36.     With Me.ListView1
    
37.         .Sorted = False
    
38.         .ListItems.Clear
    
39.         For I = 1 To rst.RecordCount
    
40.             .ListItems.Add , , rst.Fields(0)
    
41.             For j = 1 To rst.Fields.Count - 1
    
42.                 .ListItems(I).SubItems(j) = IIf(IsNull(rst.Fields(j)), "", rst.Fields(j))
    
43.             Next j
    
44.             rst.MoveNext
    
45.         Next I
    
46.     End With
    
47.     rst.Close: Set rst = Nothing
    
48.     cnn.Close: Set cnn = Nothing
    
49.     Exit Sub
    
50. 
    
51. errorhandler:
    
52.     MsgBox Err.Description
    
53. End Sub

复制代码

跳转到最佳答案楼层

我心飞翔410

点名花亲的 我们旁边站 肯定不会

c888

我心飞翔410 发表于 2013-8-21 16:54
点名花亲的 我们旁边站 肯定不会

谢谢，这个问题刚才hwc2ycy师帮忙过！

hwc2ycy

不知道理解对不对，我理解为你双击查询相关的数据。

1. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
   
2.     Dim sql$, I%, r%
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     Set rst = CreateObject("ADODB.Recordset")
   
5.     With Sheets("Sheet3")
   
6.         r = .Range("a65536").End(xlUp).Row
   
7.     End With
   
8.     cnn.Open "Provider =Microsoft.Jet.OLEDB.4.0;Extended properties= Excel 8.0;Data source=" & ThisWorkbook.FullName
   
9.     With TreeView1
   
10.         For I = 1 To .Nodes.Count
    
11.             If .Nodes(I).Children = 0 Then
    
12.                 If .Nodes(I).Selected Then
    
13.                     .Nodes(I).Image = 4
    
14.                 Else
    
15.                     .Nodes(I).Image = 3
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.     End With
    
20. 
    
21.     On Error GoTo errorhandler
    
22.     sql = "select * from [sheet3$a2:w" & r & "]"
    
23.     Select Case UBound(Split(Node.FullPath, "")) + 1
    
24.         Case 1:
    
25.             sql = "select * from [sheet3$a2:w" & r & "]"
    
26.         Case 2:
    
27.             sql = sql & "  where 名称 = '" & Node.Text & "'"
    
28. 
    
29.         Case 3:
    
30.             sql = sql & "  where 班级 = '" & Node.Text & "'"
    
31.         Case 4:
    
32.             sql = sql & "  where 姓名 = '" & Node.Text & "'"
    
33.     End Select
    
34.    
    
35.     rst.Open sql, cnn, 3, 1
    
36.     If rst.RecordCount = 0 Then MsgBox "未找到记录！", vbInformation, "友情提示": Exit Sub
    
37.     With Me.ListView1
    
38.         .Sorted = False
    
39.         .ListItems.Clear
    
40.         For I = 1 To rst.RecordCount
    
41.             .ListItems.Add , , rst.Fields(0)
    
42.             For j = 1 To rst.Fields.Count - 1
    
43.                 .ListItems(I).SubItems(j) = IIf(IsNull(rst.Fields(j)), "", rst.Fields(j))
    
44.             Next j
    
45.             rst.MoveNext
    
46.         Next I
    
47.     End With
    
48.     rst.Close: Set rst = Nothing
    
49.     cnn.Close: Set cnn = Nothing
    
50. 
    
51. errorhandler:
    
52.     If Err.Number > 0 Then MsgBox Err.Description
    
53. End Sub

复制代码

hwc2ycy

1. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
   
2.     Dim sql$, I%, r%
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     Set rst = CreateObject("ADODB.Recordset")
   
5.     With Sheets("Sheet3")
   
6.         r = .Range("a65536").End(xlUp).Row
   
7.     End With
   
8.     cnn.Open "Provider =Microsoft.Jet.OLEDB.4.0;Extended properties= Excel 8.0;Data source=" & ThisWorkbook.FullName
   
9.     With TreeView1
   
10.         For I = 1 To .Nodes.Count
    
11.             If .Nodes(I).Children = 0 Then
    
12.                 If .Nodes(I).Selected Then
    
13.                     .Nodes(I).Image = 4
    
14.                 Else
    
15.                     .Nodes(I).Image = 3
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.     End With
    
20. 
    
21.     On Error GoTo errorhandler
    
22.     sql = "select * from [sheet3$a2:w" & r & "]"
    
23.     Select Case UBound(Split(Node.FullPath, "")) + 1
    
24.         Case 1:
    
25.         Case 2:
    
26.             sql = sql & "  where 名称 = '" & Node.Text & "'"
    
27.         Case 3:
    
28.             sql = sql & "  where 班级 = '" & Node.Text & "'"
    
29.         Case 4:
    
30.             sql = sql & "  where 姓名 = '" & Node.Text & "'"
    
31.     End Select
    
32.    
    
33.     rst.Open sql, cnn, 3, 1
    
34.     If rst.RecordCount = 0 Then MsgBox "未找到记录！", vbInformation, "友情提示": Exit Sub
    
35.    
    
36.     With Me.ListView1
    
37.         .Sorted = False
    
38.         .ListItems.Clear
    
39.         For I = 1 To rst.RecordCount
    
40.             .ListItems.Add , , rst.Fields(0)
    
41.             For j = 1 To rst.Fields.Count - 1
    
42.                 .ListItems(I).SubItems(j) = IIf(IsNull(rst.Fields(j)), "", rst.Fields(j))
    
43.             Next j
    
44.             rst.MoveNext
    
45.         Next I
    
46.     End With
    
47.     rst.Close: Set rst = Nothing
    
48.     cnn.Close: Set cnn = Nothing
    
49.     Exit Sub
    
50. 
    
51. errorhandler:
    
52.     MsgBox Err.Description
    
53. End Sub

复制代码

c888

hwc2ycy 发表于 2013-8-21 18:17

谢谢hwc2ycy师，您用鼠标双击树目录，将数据复制到Listview中，这样也可以。
我意思是用鼠标点树目录，然后拖拽到 Listview中，放开鼠标即可完成数据复制。如附件中用鼠标点树目录中的“我的学校”目录， 然后将光标拖拽到Listview中，即可将“我的学校”所有数据复制到Listview中。只是下一级不知如何改写。谢谢！
（提示：附件中的第一级已经有这种代码了）

hwc2ycy

拖的话是遍历CHILD和ITEM。
我猜的，

c888

hwc2ycy 发表于 2013-8-21 20:33
拖的话是遍历CHILD和ITEM。
我猜的，

谢谢老师：下面是3级的代码，如何改为4级。谢谢！

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
   Cancel = True
   Effect = 1
   Dim sql$, I%, r%
   Set cnn = CreateObject("ADODB.Connection")
   Set rst = CreateObject("ADODB.Recordset")
   With Sheets("Sheet3")
      r = .Range("a65536").End(xlUp).Row
   End With
   cnn.Open "Provider =Microsoft.Jet.OLEDB.4.0;Extended properties= Excel 8.0;Data source=" & ThisWorkbook.FullName
   With Me.TreeView1
      If .SelectedItem.Children = 0 Then            
         sql = "select * from [sheet3$a2:w" & r & "] where 我的学校 = '" & .SelectedItem.Parent & "' and  姓名 = '" & .SelectedItem.Text & "'" '
         rst.Open sql, cnn, 3, 1
         If rst.RecordCount = 0 Then MsgBox "未找到记录！", vbInformation, "友情提示": Exit Sub
      ElseIf .SelectedItem.Parent Is Nothing Then      
         sql = "select * from [sheet3$a2:w" & r & "]"
         rst.Open sql, cnn, 3, 1
      Else                                             
         sql = "select * from [sheet3$a2:w" & r & "]  where 我的学校 = '" & .SelectedItem.Text & "'"
         rst.Open sql, cnn, 3, 1
      End If
   End With
   With Me.ListView1
      .Sorted = False                                      
      For I = 1 To rst.RecordCount                          
         Set ITM = ListView1.ListItems.Add(, , IIf(IsNull(rst.Fields(0)), "", rst.Fields(0)))
         For j = 1 To rst.Fields.Count - 1
            ITM.SubItems(j) = IIf(IsNull(rst.Fields(j)), "", rst.Fields(j))
            Next
            rst.MoveNext
         Next
      .SelectedItem.Selected = False         
   End With
   rst.Close: Set rst = Nothing
   cnn.Close: Set cnn = Nothing
End Sub

hwc2ycy

c888 发表于 2013-8-21 21:50
谢谢老师：下面是3级的代码，如何改为4级。谢谢！

Private Sub ListView1_OLEDragDrop(Data As MSComc ...

你这Data参数都没有用到，不算真正意义上的拖拽操作了。
只能说是取得巧。

hwc2ycy

你把我之前的那个代码稍微改下就能用在这里了。
我那个实现了2，3，4层。