TREEVIEW查找的问题

loginwjd303

应用论坛上一老师的TREEVIEW查找代码到自己的TREE上但就是不行。请老师帮忙。
不会展开，单一节点就选不到如图所示

loginwjd303

Private Sub Form_Load()

    Dim Conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim strCARGOTYPE_NO As String
    Dim MaxLevel As Integer
    Dim i As Integer


    Set Conn = CurrentProject.Connection

    Me.TreeView0.Nodes.Add , , "NO.1", "物料分类"




        
        Set rst = Conn.Execute("SELECT CARGOTYPE_LEVEL,CARGOTYPE_NO,CARGOTYPE_BM,CARGOTYPE_NAME FROM Ylfl Order By CARGOTYPE_NO")
        
        Do Until rst.EOF

            If rst!CARGOTYPE_LEVEL = 1 Then   '顶层菜单
                Me.TreeView0.Nodes.Add "NO.1", tvwChild, "NO." & Trim(rst!CARGOTYPE_NO), Trim(rst!CARGOTYPE_BM)
               
               
               
               
               
            Else
               
       Me.TreeView0.Nodes.Add "NO." & Left(rst!CARGOTYPE_NO, (rst!CARGOTYPE_LEVEL - 1) * 4), tvwChild, "NO." & Trim(rst!CARGOTYPE_NO), Trim(rst!CARGOTYPE_BM)
               
            End If
            rst.MoveNext
        Loop
On Error Resume Next
    Application.CommandBars("menuTreeView").Delete
    Dim iBar As CommandBar
    Dim iButton As CommandBarButton
    Dim iCombo As CommandBarComboBox
    Set iBar = Application.CommandBars.Add(Name:=("menuTreeView"), Position:=msoBarPopup, Temporary:=True)
    With iBar
        Set iButton = .Controls.Add(Type:=msoControlButton)
        iButton.Caption = "增加  选定节点子节点(&A)"
        iButton.OnAction = "Get_rmTreeView_PopupSelection"
        iButton.Tag = "Add"
        iButton.FaceId = 240
        
        Set iButton = .Controls.Add(Type:=msoControlButton)
        iButton.Caption = "删除  选定节点(&D)"
        iButton.OnAction = "Get_rmTreeView_PopupSelection"
        iButton.Tag = "Del"
        iButton.FaceId = 1088
        'delCARGOTYPE
        Set iButton = .Controls.Add(Type:=msoControlButton)
        iButton.Caption = "更改  选定节点文字(&M)"
        iButton.OnAction = "Get_rmTreeView_PopupSelection"
        iButton.Tag = "Mod"
        iButton.FaceId = 290
        Set iButton = .Controls.Add(Type:=msoControlButton)
        iButton.Caption = "查找下一个(&N)"
        iButton.OnAction = "Get_rmTreeView_PopupSelection"
        iButton.Tag = "NEXT"
        iButton.FaceId = 280
       ' .Controls.Add Type:=msoControlComboBox
      
        
        Set iCombo = .Controls.Add(Type:=msoControlComboBox)
        iCombo.Caption = "查找  选定节点下的文字(&F)"
        iCombo.OnAction = "Get_rmTreeView_PopupSelection"
        iCombo.Tag = "FIND"
        iCombo.DropDownLines = 8
        iCombo.DropDownWidth = 100
        iCombo.ListIndex = 0
        iCombo.BeginGroup = True
        End With
Me.TreeView0.LabelEdit = tvwManual
    Me.TreeView0.Visible = True
    Me.TreeView0.Nodes(1).Sorted = True
    Me.TreeView0.Nodes(1).Sorted = False

    Me.TreeView0.Nodes(1).Expanded = True
    'Me.TreeView0.EnsureVisible
End Sub



Private Sub TreeView0_NodeClick(ByVal node As Object)

    Dim strCARGOTYPE_NO As String
  Dim strSQL As String
   Dim i As Integer
   Dim n As Integer
   Dim strTip As String

    strCARGOTYPE_NO = Right(node.Key, Len(node.Key) - 3)
    '判断是否是顶层
    If strCARGOTYPE_NO = "1" Then  '预先定义好的:NO.1，第3位向后的字符，所以是1
     strSQL = "SELECT * FROM Ylxx;"
  '  Dim i As Long
    Me![Text01] = node.Index
     
     
       Me.lblTip.Caption = "物料分类"
        Else
        'i = Len(strCARGOTYPE_NO)
        strSQL = "SELECT * FROM Ylxx WHERE left([CARGO_TYPE]," & i & ")='" & strCARGOTYPE_NO & "';"
           Dim strCode() As String
    Dim NodeID2 As String
    strCode = Split(node.Key, ".")
    NodeID2 = strCode(UBound(strCode))
   
   
     Me![Text01] = node.Index
        'Debug.Print I
        For n = 1 To i / perSectionLong
            strTip = strTip & Trim(CurrentDb.OpenRecordset("SELECT CARGOTYPE_BM FROM Ylfl where left([CARGOTYPE_NO]," _
                                                         & (n * perSectionLong) & ")='" & Left(strCARGOTYPE_NO, (n * perSectionLong)) & "' and CARGOTYPE_LEVEL=" & n & ";")(0).Value) & ">>"
        Next
       ' strTip = "物料分类" & ">>" & Left(strTip, Len(strTip) - 2)
        Me.lblTip.Caption = strTip
End If
    'Debug.Print strSQL
Me.Yl.Form.RecordSource = strSQL
  'Me.产品1.Form.RecordSource = strSQL
Me.Form.FilterOn = True
Me.Form.Filter = strSQL

End Sub
Private Sub treeview0_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
    Dim mNode As node
    Dim NodeID As String
    Dim strCode() As String
    Dim strSQL As String
    Dim rst As DAO.Recordset
    Set mNode = TreeView0.SelectedItem
    Dim i As Integer
    strCode = Split(mNode.Key, "_")
    NodeID = strCode(UBound(strCode))
    'If blNodeClick Then
        If Button = 2 Then             ' 鼠标右键 点击 TreeView的Node
            iSQLs = ""                 '公用变量
            Dim combo As CommandBarControl
            Set combo = CommandBars("menuTreeView").FindControl(Tag:="FIND")
'            combo.Text = ""
            Application.CommandBars("menuTreeView").ShowPopup
            Select Case UCase(iSQLs)        '公用变量 iSQLs 的值由CommandBars("menuTreeView").ShowPopup的指定宏返回
            Case "ADD"
            Call addCARGOTYPE
            Case "del"
            Call delCARGOTYPE
            Case "NEXT"
             Call popFIND(mNode, Trim(combo.Text), False)
            ''Case findA
           
              Case "FIND"
                    If Trim(combo.Text) <> "" Then
                      Me.Painting = False
                        DoCmd.Hourglass True
                      Call popFIND(mNode, Trim(combo.Text), False)
                       With combo
                            Dim listFound As Boolean
                            If .ListCount > 0 Then
                               For i = 1 To .ListCount
                                   If .List(i) = .Text Then
                                        listFound = True
                                   End If
                               Next
                          End If
                           If listFound = False Then .AddItem .Text
                        End With
                        Me.Painting = True
                        DoCmd.Hourglass False
                    End If
                    End Select
                    End If
                   End Sub
Function popFIND(NodeX As node, findText As String, blnFound As Boolean)
If blnFound = True Then Exit Function
Dim i As Integer
On Error Resume Next
' tj = Nz(Me.Text27, 0)
'If Nz(Me.Text27, 0) = 0 Then Exit Sub
For i = Inti + 1 To Me.TreeView0.Nodes.Count
    If Me.TreeView0.Nodes(i).Text Like "*" & Trim(findText) & "*" Then
        Me.TreeView0.Nodes(i).Selected = True
        Me.TreeView0.SetFocus
        TreeView0_NodeClick Me.TreeView0.SelectedItem
        Inti = i
        Exit Function
    End If
    Inti = i
Next
If Inti = Me.TreeView0.Nodes.Count Then
Inti = 1
MsgBox "没有了"
Exit Function
End If
'If NodeX.Children = 0 Then Exit Function

  ' Dim i As Long
  ' strCode = Split(NodeX.Key, ".")
  ' NodeID = strCode(UBound(strCode))
  ' Dim childNode As node
   'If InStr(1, NodeX.Text, findText, vbTextCompare) > 0 Then
           'NodeX.Selected = True
           'If NodeX.Index > 1 Then NodeX.Parent.Expanded = True
'            blnFound = True
            'Exit Function
    '  End If
        
          ' Set childNode = NodeX.Child
          ' For i = 1 To NodeX.Children
          ' Call popFIND(childNode, findText, blnFound)
          ' Set childNode = childNode.Next
          ' Next
   
   
End Function

以上代码解决自己的问题

ZHENGLIAN

loginwjd303 ,,你的树挺好给我一份好吗