Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Drag & Drop mehrspaltige Listbox
Detlef
Hallo Excel-Profis´s
ich habe in der Excelhilfe ein Beispiel für Drag & Drop von Listbox zu Listbox gefunden; leider funktioniert das nur bei einspaltigen Listboxen
Ich habe aber als Ausgang (Listbox1) eine zweispaltige Listbox und in Listbox2 sollen die Daten auch wieder zweispaltig ankommen
Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal DragState As Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Cancel = True
Effect = 1
End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal Effect As _
MSForms.ReturnEffect, ByVal Shift As Integer)
Cancel = True
Effect = 1
ListBox2.AddItem Data.GetText
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject As DataObject
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag
End If
End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem "Choice " _
& (ListBox1.ListCount + 1)
Next i
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Drag & Drop mehrspaltige Listbox
12.06.2010 21:06:53
Nepumuk
Hallo Detlef,
mit ein bisschen Nachdenken hättest du das selber gekonnt.
Option Explicit

Private Const SEPARATOR = "Þ"

Private Sub ListBox2_BeforeDragOver( _
        ByVal Cancel As MSForms.ReturnBoolean, _
        ByVal Data As MSForms.DataObject, _
        ByVal X As Single, _
        ByVal Y As Single, _
        ByVal DragState As Long, _
        ByVal Effect As MSForms.ReturnEffect, _
        ByVal Shift As Integer)

    
    Cancel = True
    Effect = 1
    
End Sub

Private Sub ListBox2_BeforeDropOrPaste( _
        ByVal Cancel As MSForms.ReturnBoolean, _
        ByVal Action As Long, _
        ByVal Data As MSForms.DataObject, _
        ByVal X As Single, _
        ByVal Y As Single, _
        ByVal Effect As MSForms.ReturnEffect, _
        ByVal Shift As Integer)

    
    Dim strText As String
    
    Cancel = True
    Effect = 1
    
    strText = Data.GetText
    
    With ListBox2
        .AddItem
        .List(.ListCount - 1, 0) = Split(strText, SEPARATOR)(0)
        .List(.ListCount - 1, 1) = Split(strText, SEPARATOR)(1)
    End With
    
End Sub

Private Sub ListBox1_MouseMove( _
        ByVal Button As Integer, _
        ByVal Shift As Integer, _
        ByVal X As Single, _
        ByVal Y As Single)

    
    Dim MyDataObject As DataObject
    Dim Effect As Integer
    Dim strText As String
    
    If Button = 1 Then
        Set MyDataObject = New DataObject
        With ListBox1
            strText = .List(.ListIndex, 0) & _
                SEPARATOR & .List(.ListIndex, 1)
        End With
        MyDataObject.SetText strText
        Effect = MyDataObject.StartDrag
    End If
    
End Sub

Private Sub UserForm_Activate()
    Dim intIndex As Integer
    With ListBox1
        For intIndex = 1 To 10
            .AddItem
            .List(.ListCount - 1, 0) = "Column 1 " _
                & CStr(intIndex)
            .List(.ListCount - 1, 1) = "Column 2 " _
                & CStr(intIndex)
        Next
    End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Drag & Drop mehrspaltige Listbox
12.06.2010 21:56:03
Detlef
Danke Nepumuk
hab noch etwas experimentiert und bin auf diese (nicht ganz elegante Lösung) gekommen; die Länge des zweiten Textteils ist nicht optimal berechnet mir reichts im Moment aber so
Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal DragState As Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Cancel = True
Effect = 1
End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal Effect As _
MSForms.ReturnEffect, ByVal Shift As Integer)
Cancel = True
Effect = 1
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount - 1, 0) = Mid(Data.GetText, 1, InStr(1, Data.GetText, "#")  _
- 1)
ListBox2.List(ListBox2.ListCount - 1, 1) = Mid(Data.GetText, InStr(1, Data.GetText, "#") +  _
1, Len(Data.GetText))
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject1 As DataObject
If Button = 1 Then
txt = ListBox1.List(ListBox1.ListIndex, 0) & "#" & ListBox1.List(ListBox1.ListIndex, 1)
Set MyDataObject1 = New DataObject
Dim Effect As Integer
MyDataObject1.SetText txt
Effect = MyDataObject1.StartDrag
End If
End Sub
Private Sub UserForm_Initialize()
For a = 11 To 15
ListBox1.AddItem
ListBox1.List(a - 11, 0) = Cells(a, 1)
ListBox1.List(a - 11, 1) = Cells(a, 2)
Next a
ListBox1.ListIndex = 1
End Sub

Gruß Detlef
Auf Euch Profis kann man sich eben immer wieder verlassen
Anzeige

258 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige