I could not find any proper solution on Google and I would like to know whether there is a possible solution for my intention.
I would like 2 TreeView Controls to interact with each other. The user should be able to drag an element from the left side and drop it into the right hand side TreeView control. The elements on the left side which have been moved should go away from the left hand side TreeView control and should be visible on the right TreeView. Whether it will become a child of the element which the user highligthed or being a sibbling is not so relevant as of know because first question to be answered would be whether it is possible.
What I have so far is module1:
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Public Function PixelsPerInch(Par As Integer) As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, Par)
PixelsPerInch = lDotsPerInch
ReleaseDC 0, hDC
End Function
Public Sub createPopUp()
Dim oComBar As CommandBar
On Error Resume Next
Application.CommandBars("PopUp").Delete
Set oComBar = CommandBars.Add(Name:="PopUp", Position:=msoBarPopup, Temporary:=True)
createMenueButton "Neues Unterelement einfügen", 462
createMenueButton "Element kopieren", 19
createMenueButton "Element ausschneiden", 21
createMenueButton "Element einfügen", 22
createMenueButton "Element löschen (mit Unterelementen)", 464
createMenueButton "Element löschen (ohne Unterelemente)", 464
End Sub
Private Sub createMenueButton(strButText As String, iFaceId As Integer)
Dim oBut As CommandBarButton
Set oBut = Application.CommandBars("PopUp").Controls.Add()
oBut.FaceId = iFaceId
oBut.Caption = strButText
Set oBut = Nothing
End Sub
...and the code inside the Form:
' Necessary libraries to be activated:
'' - Microsoft Forms x.0 Objekt Library
'' - Microsoft Windows Common Controls x.0 (SPx)
' Für ausgewählten Node (Drag and Drop)
Private oSelectedNode As MSComctlLib.Node
Private Sub TreeView1_LostFocus()
' Verlassen des TreeViews -> Kein Highlighting
Set TreeView1.DropHighlight = Nothing
End Sub
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)
' Hier wird vor dem Drag and Drop sichergestellt, dass der Selected Item auch der aktuell ausgewählte Node ist
' MouseDown wird vor dem Drag and Drop Event ausgeführt
' TreeView1.HitTest verlangt in VBA (vermutl. abweichend zu VB) die x und y Koordinate in TWIPS (Twentieth of an Inch Point) also 1 / 1400 Zoll
' http://de.wikipedia.org/wiki/Twip
Dim XFactor As Double, YFactor As Double
' Ermittlung der PPI (PixelPerInch) auf dem Client Rechner
' Entspricht im Normalfall den DPI Einstellungen: Desktop -> rechte Maustaste -> Eigenschaften -> Allgemein
' 90 = Vertikal 88 = Horizontal
XFactor = PixelsPerInch(88)
YFactor = PixelsPerInch(90)
Set oSelectedNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
Set TreeView1.DropHighlight = oSelectedNode
Set TreeView1.SelectedItem = oSelectedNode
End Sub
Private Sub TreeView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
' Popup Menü im TreeView bei klick auf Rechte Maustaste
Dim oNode As MSComctlLib.Node
Dim XFactor As Double, YFactor As Double
If Button <> vbKeyRButton Then Exit Sub
' Procedere wie beschrieben
XFactor = PixelsPerInch(88)
YFactor = PixelsPerInch(90)
Set oNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
' Kein Node -> kein Popup
If oNode Is Nothing Then Exit Sub
' Popup abhängig von dem gewählten Node:
CommandBars("PopUp").Controls("Element ausschneiden").Enabled = Not oNode.Parent Is Nothing
CommandBars("PopUp").Controls("Element löschen (mit Unterelementen)").Enabled = Not oNode.Parent Is Nothing
CommandBars("PopUp").Controls("Element löschen (ohne Unterelemente)").Enabled = Not oNode.Parent Is Nothing
CommandBars("PopUp").ShowPopup
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)
' Hier wird das Drag and Drop durchgeführt
Dim oNodeNewPosition As MSComctlLib.Node
Dim XFactor As Double, YFactor As Double
' Verschieben des Root-Elements soll nicht möglich sein
If oSelectedNode.Parent Is Nothing Then Exit Sub
' Procedere wie beschrieben
XFactor = PixelsPerInch(88)
YFactor = PixelsPerInch(90)
Set oNodeNewPosition = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
' Cycle verhindern (Drag and Drop auf gleiche Position)
If oSelectedNode = oNodeNewPosition Then Exit Sub
If Not oNodeNewPosition Is Nothing Then
Set oSelectedNode.Parent = oNodeNewPosition
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)
' Higlighting für das Element über das der "Drag" gerade ist
Dim oNode As MSComctlLib.Node
Dim XFactor As Double, YFactor As Double
' Procedere wie beschrieben
XFactor = PixelsPerInch(88)
YFactor = PixelsPerInch(90)
Set oNode = TreeView1.HitTest(x * 1440 / XFactor, y * 1440 / YFactor)
If oNode Is Nothing Then Exit Sub
Set TreeView1.DropHighlight = oNode
End Sub
Public Sub fillTreeView()
' TreeView mit Testdaten füllen
Dim oNode As MSComctlLib.Node
TreeView1.LineStyle = tvwRootLines
TreeView1.Nodes.Clear
Set oNode = TreeView1.Nodes.Add(, , , "AP0: RootElement")
Set oNode = TreeView1.Nodes.Add(1, tvwChild, , "AP1: Entwicklung")
Set oNode = TreeView1.Nodes.Add(1, tvwChild, , "AP2: Test")
Set oNode = TreeView1.Nodes.Add(3, tvwChild, , "AP21: Test Struktur")
Set oNode = TreeView1.Nodes.Add(2, tvwChild, , "AP12: Entwicklung Software")
Set oNode = TreeView1.Nodes.Add(3, tvwChild, , "AP22: Test Verhalten")
For Each oNode In TreeView1.Nodes
oNode.EnsureVisible
Next
TreeView1.OLEDragMode = ccOLEDragAutomatic
TreeView1.OLEDropMode = ccOLEDropManual
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim ii As Long
Dim iii As Long
' TreeView mit ein paar Parent- und Child-
' Elementen füllen
With Me.TreeView1
For i = 1 To 5
' Hauptknoten (Parent-Nodes)
.Nodes.Add , tvwFirst, "MainNode_" & i, _
"MainNode_" & i
For ii = 1 To 10
' Unterkonten (Child-Nodes)
Me.TreeView1.Nodes.Add "MainNode_" & i, _
tvwChild, "Child_" & i & "_" & ii, _
"Child_" & i & "_" & ii
' Und Unter-Unterknoten
For iii = 1 To 5
Me.TreeView1.Nodes.Add "Child_" & i & "_" & ii, _
tvwChild, "Child_" & i & "_" & ii & "_" & iii, _
"Child_" & i & "_" & ii & "_" & iii
Next iii
Next ii
Next i
.OLEDragMode = ccOLEDragAutomatic
.OLEDropMode = ccOLEDropManual
End With
With Me.TreeView2
For i = 1 To 5
' Hauptknoten (Parent-Nodes)
.Nodes.Add , tvwFirst, "MainNode_" & i, _
"MainNode_" & i
For ii = 1 To 10
' Unterkonten (Child-Nodes)
Me.TreeView2.Nodes.Add "MainNode_" & i, _
tvwChild, "Child_" & i & "_" & ii, _
"Child_" & i & "_" & ii
' Und Unter-Unterknoten
For iii = 1 To 5
Me.TreeView2.Nodes.Add "Child_" & i & "_" & ii, _
tvwChild, "Child_" & i & "_" & ii & "_" & iii, _
"Child_" & i & "_" & ii & "_" & iii
Next iii
Next ii
Next i
.OLEDragMode = ccOLEDragAutomatic
.OLEDropMode = ccOLEDropManual
End With
End Sub
credits to AndiGast from http://www.office-loesung.de/ftopic280909_0_0_asc.php (german website)
