treeview的排序

龙　发表于：2015-09-21 06:19:32 　

求助，哪位老师知道树形从"孙"节点后接下来是怎么排序的？写到“孙”节点就不知道接下来是什么了？...谢谢！

rs.Open "产线总数", cnn, adOpenStatic, adLockOptimistic, adCmdTableDirect

         For i = 0 To rs.RecordCount - 1

         Set nodx = TreeView.Nodes.Add("孙" & rs.Fields("所属生产总数ID"), tvwChild, "孙" & rs.Fields("产线总数ID"), rs.Fields("StatusDescription") & "--" & rs.Fields("计数") & "台")

         nodx.Sorted = True

         rs.MoveNext

         Next

         rs.Close

？？？？？

Top

chinasa 发表于：2015-09-21 08:14:15

Top

chinasa 发表于：2015-09-21 08:15:00

Top

chinasa 发表于：2015-09-21 08:15:26

为啥怎么回复都空白呢？

Top

chinasa 发表于：2015-09-21 08:16:20

看来是代码太长，我分段复制吧。

Private Sub xTree_OLEStartDrag(Data As Object, AllowedEffects As _
         Long)
      'Exit Sub
      Me!xTree.Object.SelectedItem = Nothing
      End Sub

Top

chinasa 发表于：2015-09-21 08:16:34

Private Sub xTree_OLEDragOver(Data As Object, Effect As Long, _
         Button As Integer, Shift As Integer, x As Single, Y As Single, _
         State As Integer)
     'Exit Sub
      Dim oTree As TreeView

      Set oTree = Me!xTree.Object
      ' 如无节点被选中，则选择你曾经拖过的第一个.
      If oTree.SelectedItem Is Nothing Then
         Set oTree.SelectedItem = oTree.HitTest(x, Y)
      End If
      ' 高亮显示.
      Set oTree.DropHighlight = oTree.HitTest(x, Y)
      End Sub

Top

chinasa 发表于：2015-09-21 08:16:47

Private Sub xTree_OLEDragDrop(Data As Object, Effect As Long, _
         Button As Integer, Shift As Integer, x As Single, Y As Single)
      'Exit Sub
      On Error GoTo ErrxTree_OLEDragDrop
      Dim oTree As TreeView, strKey As String, strText As String
      Dim nodNew As Node, nodDragged As Node
      Dim db As Database, rs As Recordset

      Set db = CurrentDb
      ' 打开表进行编辑.
      Set rs = db.OpenRecordset("accxp", dbOpenDynaset)

      Set oTree = Me!xTree.Object
      ' 如无节点被选中，则下课休息
      If oTree.SelectedItem Is Nothing Then
      Else   '相反

         Set nodDragged = oTree.SelectedItem
         ' 如果节点被拖放到空白区,则修改数据表并将其设为根节点
          If oTree.DropHighlight Is Nothing Then
            ' 保存KEY值及显示文本以备重新装入时使用.
            strKey = nodDragged.Key
            strText = nodDragged.Text
            '删除当前对象的节点.
            oTree.Nodes.Remove nodDragged.Index
            ' 在数据表中查找该记录并修改之.
            rs.FindFirst "[ID]=" & Mid(strKey, 2)
            rs.Edit
               rs![Parent] = Null
            rs.Update
            '将其装入为根节点.
            Set nodNew = oTree.Nodes.Add(, , strKey, strText, 1, 3)
            ' 装入其所有子节点
            AddChildren nodNew, rs
         ElseIf nodDragged.Index <> oTree.DropHighlight.Index Then
            Set nodDragged.Parent = oTree.DropHighlight
            rs.FindFirst "[ID]=" & Mid(nodDragged.Key, 2)
            rs.Edit
               rs![Parent] = Mid(oTree.DropHighlight.Key, 2)
            rs.Update
         End If
      End If
      ' 取消选择
      Set nodDragged = Nothing
      ' 取消高亮.
      Set oTree.DropHighlight = Nothing
ExitxTree_OLEDragDrop:
         Exit Sub
ErrxTree_OLEDragDrop:

         If Err.Number = 35614 Then
            MsgBox "呵呵，你想让上级被下级管呀？？？", _
               vbCritical, "CNWang的警告:"
         Else
            MsgBox "节点移动错误. " & _
            "请再试一次." & vbCrLf & Error.Description
         End If
         Resume ExitxTree_OLEDragDrop
      End Sub

Top

chinasa 发表于：2015-09-21 08:17:14

别人的代码，主人的姓名忘记了，在此鸣谢，并于楼主分享。

Top

chinasa 发表于：2015-09-21 08:17:50

   '==================================================================
      '子过程，加入子节点及孙节点
      '==================================================================
      Sub AddChildren(nodBoss As Node, rst As Recordset)
      On Error GoTo ErrAddChildren
      Dim nodCurrent As Node
      Dim objTree As TreeView, strText As String, bk As String

      ' 变量.
      Set objTree = Me!xTree.Object
      ' 查找第一个子节点
      rst.FindFirst "[parent] =" & Mid(nodBoss.Key, 2)
      ' 装入数据
      Do Until rst.NoMatch
         ' 取得NAME.
         strText = rst![Name]
         ' 加入子节咪.
         Set nodCurrent = objTree.Nodes.Add(nodBoss, tvwChild, "a" & _
            rst!ID, strText, 2, 3)
         ' 保存位置
         bk = rst.Bookmark
         ' 装入下层节点
         AddChildren nodCurrent, rst
         ' 返回并继续查找
         rst.Bookmark = bk
         ' 查找下一个
         rst.FindNext "[parent]=" & Mid(nodBoss.Key, 2)
      Loop

ExitAddChildren:
         Exit Sub
ErrAddChildren:
         MsgBox "Can't add child: " & Err.Description, vbCritical, _
            "AddChildren(nodBoss As Node) Error:"
         Resume ExitAddChildren
      End Sub

Top

wsxljx 发表于：2015-09-21 22:22:30

谢谢chinasa老师的解决方案。

Top

总记录：9篇页次：1/1 9 1 :

Access交流中心

treeview的排序