---

Hallo,

habe in einem VBA - Projekt ein TreeView mit mehreren Einträgen. Nun möchte ich dass der Benutzer mittels Drag & Drop die Childs in andere Parents, also Guppen ziehen kann. Habe ein Beispiel gefunden, da bekomm ich in dieser Funktion folgenden Fehler:

Code:

---

Private Sub trvParts_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Dim oDragNode As MSComctlLib.Node
 
    Data.Clear
 
    ' Nicht für Root Nodes geeignet
    If Not trvParts.SelectedItem.Parent Is Nothing Then
        Data.SetData Me.trvParts.SelectedItem.key, 1
    End If
End Sub

---

Fehler:
Laufzeitfehler 91:
Objektvariable oder With - Blockvariable nicht festgelegt!

Kann mir jemand helfen, oder hat jemand ein Beispiel das auch funktioniert?!

------------------
Grüse Benny

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Benny,

mit VBA und vor allem Drag&Drop innerhalb eines Treeviews hab ich auch noch nicht gemacht. In VBA scheint es einige Schwierigkeiten zu geben. Hier mal ein Beispiel. Hie müssten noch einige Fehlerabfragen rein das man das Node nicht in einen Unterast verschiebt usw..
Versuch mal selbst. Du braucht eine Form mit einem Treeview.

Code:

---

Option Explicit

Dim blnDragging As Boolean
Const faktor As Single = 20

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)
    Dim nodNode As node
    If Button = 1 Then
      TreeView1.OLEDrag
    End If
    Set nodNode = TreeView1.HitTest(x * faktor, y * faktor)
    If nodNode Is Nothing Then Exit Sub '// no node

End Sub

Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim nodTarget As node
    Dim nodOrginal As node
    Dim node As node
    Dim ChildNode As node
    Dim NextChildNode As node
    Set nodTarget = TreeView1.HitTest(x * faktor, y * faktor)
   
    If Not nodTarget Is Nothing Then
        Set nodOrginal = TreeView1.SelectedItem
        If nodTarget = nodOrginal Then
          Exit Sub
        End If
         
        Set node = TreeView1.Nodes.Add(nodTarget, tvwChild, "~" & nodOrginal.key, nodOrginal.Text)
        Set ChildNode = nodOrginal.Child
        While Not ChildNode Is Nothing
            Set NextChildNode = ChildNode.Next
            Set ChildNode.Parent = node
            TreeView1.Refresh
            Set ChildNode = NextChildNode
        Wend
        blnDragging = False
    End If
End Sub

Private Sub TreeView1_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    Dim nodNode As node
    Effect = ccOLEDropEffectMove
    Set nodNode = TreeView1.HitTest(x * faktor, y * faktor)
    If nodNode Is Nothing Or blnDragging = False Then
      Effect = ccOLEDropEffectNone
      Me.Caption = ""
    Else
      Me.Caption = "Ziel ist: " & nodNode.Text
      nodNode.CreateDragImage
    End If
     
End Sub

Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    AllowedEffects = ccOLEDropEffectMove
    blnDragging = True
End Sub

Private Sub UserForm_Initialize()
    Dim RootNode As node
    Dim G1Node As node
    Dim G2Node As node
    Dim ChildNode As node
   
    TreeView1.OLEDragMode = ccOLEDragAutomatic
    TreeView1.OLEDropMode = ccOLEDropManual
   
    Set RootNode = TreeView1.Nodes.Add(, tvwFirst, "Root", "Root")
    Set G1Node = TreeView1.Nodes.Add(RootNode, tvwChild, RootNode.key & "\G1", "G1")
    Set G2Node = TreeView1.Nodes.Add(RootNode, tvwChild, RootNode.key & "\G2", "G2")
    Set ChildNode = TreeView1.Nodes.Add(G1Node, tvwChild, G1Node.key & "\1", "Child1")
    Set ChildNode = TreeView1.Nodes.Add(G1Node, tvwChild, G1Node.key & "\2", "Child2")
    Set ChildNode = TreeView1.Nodes.Add(G2Node, tvwChild, G2Node.key & "\3", "Child3")
    Set ChildNode = TreeView1.Nodes.Add(G2Node, tvwChild, G2Node.key & "\4", "Child4")
   
    RootNode.Expanded = True
End Sub

---

In deinem Code fehlt wohl eine Set Anweisung.
Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

das scheint zu funktionieren, muss nur noch etwas dran rumbasteln, dass es auch wirklich funkt!

Mal sehen ob ichs hinbekomme!

Danke jedenfalls für das Beispiel!!

------------------
Grüse Benny

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Benny,
habs mir nochmal angeschaut. Hier mal eine Version die ganz gut läuft. Das Problem ist noch die Rückgabe der Koordinaten der Mausposition. Die werden in einer anderen Scalierung zurückgegeben. Ich habs mal mit zwei Umrechnungsfaktoren gelöst. Vielleicht findest du ja noch eine andere Lösung (API? ) zur Umrechnung der Koordinaten.

Code:

---

Option Explicit
Const faktor As Single = 20
Const OleFaktor As Single = 12

Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim SourceNode As node
    If Button = 1 Then
        Set SourceNode = TreeView1.HitTest(x * OleFaktor, y * OleFaktor)
        If Not SourceNode Is Nothing Then
           ' Bei Klick Auswahländern , sonst muss 2* geklickt werden
           Set TreeView1.SelectedItem = SourceNode
           Me.Caption = SourceNode.Text
        Else
           Me.Caption = ""
        End If
    End If
End Sub

Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim NewNode As node
    Dim TargetNode As node
    Dim SourceNode As node
    Dim ChildNode As node
    Dim NextChildNode As node
   
    ' Quelle
    Set SourceNode = TreeView1.SelectedItem
    ' Ziel verfügbar ?
    Set TargetNode = TreeView1.HitTest(x * faktor, y * faktor)
   
    If Not TargetNode Is Nothing Then
        ' Ist Quelle = Ziel, geht nicht
        If TargetNode = SourceNode Then
           Me.TreeView1.Refresh
           Exit Sub
        End If
        ' Node kopieren
        Set NewNode = TreeView1.Nodes.Add(TargetNode, tvwChild, "~" & SourceNode.key, SourceNode.Text)
        ' Untergeordnete Nodes auf neuen Knoten ziehen
        Set ChildNode = SourceNode.Child
        ' Falls in einen untergeordneten Ast gezogen wird
        On Error GoTo errParent
        While Not ChildNode Is Nothing
            Set NextChildNode = ChildNode.Next
            ' Parentnode ändern
            Set ChildNode.Parent = NewNode
            TreeView1.Refresh
            Set ChildNode = NextChildNode
        Wend
        On Error GoTo 0
        ' altes Node entfernen
        TreeView1.Nodes.Remove (SourceNode.key)
        ' key des neuen Nodes ändern
        NewNode.key = Mid$(NewNode.key, 2)
    End If
    Exit Sub
errParent:
        ' Bei Fehler
        ' Untergeordnete Nodes wieder auf alten Knoten ziehen
        Set ChildNode = NewNode.Child
        ' Falls in einen untergeordneten Ast gezogen wird
        While Not ChildNode Is Nothing
            Set NextChildNode = ChildNode.Next
            ' Parentnode ändern
            Set ChildNode.Parent = SourceNode
            TreeView1.Refresh
            Set ChildNode = NextChildNode
        Wend
   
      '  neues Node wieder entfernen
      TreeView1.Nodes.Remove NewNode.key
   
   
End Sub

Private Sub TreeView1_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    Dim TestNode As node
    ' Ziel prüfen
    Set TestNode = TreeView1.HitTest(x * faktor, y * faktor)
    If TestNode Is Nothing Then
       ' Kein Ziel verfügbar
       Effect = ccOLEDropEffectNone
       Me.Caption = ""
    Else
       ' Ziel verfügbar
       Effect = ccOLEDropEffectCopy
       ' Anzeigen
       Me.Caption = Me.TreeView1.SelectedItem.Text & " ==> " & TestNode.Text
    End If
     
End Sub

Private Sub TreeView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    ' Kopieren erlauben , alter Eintrag wird manuell entfernt, sonst kein Redo möglich
    AllowedEffects = ccOLEDropEffectCopy
End Sub

Private Sub UserForm_Initialize()

    Dim RootNode As node
    Dim G1Node As node
    Dim G2Node As node
    Dim ChildNode As node
   
    ' Drag & Drop aktivieren
    TreeView1.OLEDragMode = ccOLEDragAutomatic
    TreeView1.OLEDropMode = ccOLEDropManual
   
    ' Musterbaum anlegen
    Set RootNode = TreeView1.Nodes.Add(, tvwFirst, "Root", "Root")
    Set G1Node = TreeView1.Nodes.Add(RootNode, tvwChild, RootNode.key & "\G1", "G1")
    Set G2Node = TreeView1.Nodes.Add(RootNode, tvwChild, RootNode.key & "\G2", "G2")
    Set ChildNode = TreeView1.Nodes.Add(G1Node, tvwChild, G1Node.key & "\1", "Child1")
    Set ChildNode = TreeView1.Nodes.Add(G1Node, tvwChild, G1Node.key & "\2", "Child2")
    Set ChildNode = TreeView1.Nodes.Add(G2Node, tvwChild, G2Node.key & "\3", "Child3")
    Set ChildNode = TreeView1.Nodes.Add(G2Node, tvwChild, G2Node.key & "\4", "Child4")
   
    RootNode.Expanded = True
End Sub

---

Stelli

[edit err...]
------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP