Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Realisieren von Multiselect bei Drag and Drop

Forumthread: Realisieren von Multiselect bei Drag and Drop

Realisieren von Multiselect bei Drag and Drop
12.05.2007 18:07:00
Multiselect
Hallo Excelianer!
Ich will mehrfachMarkiertes von Listbox1 in Listbox2 verschieben, schaffe es aber nicht.
Bei Beginn von Drag kommt die Fehlermeldung: Unzulässige Verwendung von Null
(bei SingleSelect funktioniert es aber)
Mein bisher verwendeter Code (In UF sind 2 Listboxen vorhanden):
Der Code stammt aus der Excelhilfe.

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 = False
Effect = 1
ListBox2.AddItem Data.GetText
If ListBox1.ListCount >= 1 Then ListBox1.RemoveItem (ListBox1.ListIndex)
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
Dim i As Integer
Effect = MyDataObject.StartDrag
End If
End Sub


Hat jemand ne Idee woran`s liegt?
Danke im Voraus
Lorenz

Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Realisieren von Multiselect bei Drag and Drop
12.05.2007 19:06:00
Multiselect
Hallo Lorenz,
sicher noch verbesserbar.
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 intIndex As Integer, intCnt As Integer
Dim vTmp As Variant, vVal As Variant

On Error Resume Next

Cancel = False
Effect = 1
vTmp = Split(Data.GetText, "|")

For intIndex = 0 To UBound(vTmp)
    Redim vVal(ListBox1.ListCount - 1)
    
    For intCnt = 0 To UBound(vVal)
        vVal(intCnt) = ListBox1.List(intCnt)
    Next
    
    For intCnt = 0 To UBound(vVal)
        If vTmp(intIndex) = vVal(intCnt) Then Exit For
    Next
    
    ListBox2.AddItem vTmp(intIndex)
    ListBox1.RemoveItem (intCnt)
Next
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, intIndex As Integer, intCnt As Integer
Dim vTmp() As Variant

On Error Resume Next

If Button = 1 Then
    For intIndex = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(intIndex) Then
            Redim Preserve vTmp(intCnt)
            vTmp(intCnt) = ListBox1.List(intIndex)
            intCnt = intCnt + 1
        End If
    Next
    If intCnt > 0 Then
        Set MyDataObject = New DataObject
        MyDataObject.SetText Join(vTmp, "|")
        Effect = MyDataObject.StartDrag
    End If
End If

End Sub

Gruß Sepp

Anzeige
AW: Realisieren von Multiselect bei Drag and Drop
12.05.2007 19:15:48
Multiselect
Hallo Josef!
Funktioniert wunderbar!
vielen herzlichen Dank
u. Grüsse aus Österreich
Lorenz
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige