UF - Drag&Drop?

[snb]

Im Listobject Rang: MA=Mitarbeiter; C=Chef

Wenn du ein selektiertes Item im Listbox als erste plazieren möchtest, dann reicht diese Code:

Code:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListIndex > -1 Then ListBox1.List = Split(ListBox1.Value & "_" & Join(Filter(Application.Transpose(ListBox1.List), ListBox1.Value, 0), "_"), "_")
    Cancel = True
End Sub

[Kuwer]

Hallo Tim,

hier mal Deine Datei zurück mit Verschieben in der ListBox. Die ListBox darf aber nicht per RowSource verknüpft sein; das habe ich geändert.
Als "Variablen" habe ich mal 4 Labels eingefügt, um es besser zu visualieren. Da kann man auch richtige Variablen im Modul deklarieren.

Hier der Code fürs Verschieben mit der linken Maustaste:

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

 If ListBox1.ListIndex > -1 Then

   Label1 = ListBox1.Value

   Label2 = ListBox1.ListIndex

 Else

   Label1 = ""

   Label2 = ""

   Label3 = ""

   Label4 = ""

 End If

End Sub



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

 If ListBox1.ListIndex > -1 Then

   Label3 = ListBox1.Value

   Label4 = ListBox1.ListIndex

 End If

End Sub



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

 With ListBox1

   If .ListIndex > -1 Then

     If Label4 <> Label2 Then

       'wenn getauscht werden soll

       '.List(Label4) = Label1

       '.List(Label2) = Label3

       

       'wenn verschoben werden soll

       .RemoveItem Label2

       .AddItem Label1, Label4

       .ListIndex = -1

       .MousePointer = fmMousePointerNoDrop

     Else

       .MousePointer = fmMousePointerDefault

     End If

   End If

   Label1 = ""

   Label2 = ""

   Label3 = ""

   Label4 = ""

 End With

End Sub

  Drag&Drop-Versuch_Kuwer.xlsm (Größe: 26,82 KB / Downloads: 4)

Gruß Uwe

[EasY]

Hi ihr, 

das ist total abgefahren, dass der thread dann doch noch mal Fahrt aufnimmt.. .Wirklich klasse. Ich bin zur Zeit mit dem Handy online da ich unterwegs bin. Sobald ich zu Hause bin schaue ich mir die Lösungen auf jeden Fall an und danke herzlich. 
Ich denke aber entsprechend eurer antworten, dass der thread so erstmal als erledigt angesehen werden kann. . 

Wirklich Klasse danke

[Kuwer]

Hallo Tim,

mein erster Entwurf diente mehr zum Demonstrieren des Verschiebens in der ListBox, war aber noch fehlerhaft.

Nun habe ich das Ganze vervollständigt mit Ein- und Ausgabe und hoffe, dass es keine gravierenden Fehler beinhaltet.
Wichtig ist, vor dem Verschieben noch einmal auf den Eintrag zu klicken (lieber einmal mehr als zu wenig).

Gruß Uwe

' **************************************************************

'  Modul:  UserForm1  Typ = Userform

' **************************************************************



Option Explicit



Dim varTemp(1 To 4) As Variant



Private Sub ComboBox1_Change()

 Dim lngL As Long

 Dim objL As ListObject

 Dim varL As Variant

 

 Set objL = Worksheets("Daten").ListObjects("Tabelle1")

 varL = objL.DataBodyRange.Value

   ListBox1.Clear

   For lngL = 1 To UBound(varL)

     If varL(lngL, 1) = ComboBox1.Value Then

       ListBox1.AddItem varL(lngL, 2)

     End If

   Next lngL

End Sub



Private Sub CommandButton1_Click()

 'Speichern

 Dim lngL As Long

 Dim lngZ As Long

 Dim objL As ListObject

 Dim varL As Variant

 

 Set objL = Worksheets("Daten").ListObjects("Tabelle1")

 varL = objL.DataBodyRange.Value

 For lngL = 1 To UBound(varL)

   If varL(lngL, 1) = ComboBox1.Value Then

     lngZ = lngZ + 1

     varL(lngL, 2) = ListBox1.List(lngZ - 1)

     varL(lngL, 3) = lngZ

   End If

 Next lngL

 objL.DataBodyRange.Value = varL

End Sub



Private Sub CommandButton2_Click()

 'Verwerfen

 Unload Me

End Sub



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

 If ListBox1.ListIndex > -1 Then

   varTemp(1) = ListBox1.Value

   varTemp(2) = ListBox1.ListIndex

 Else

   Erase varTemp

 End If

End Sub



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

 If ListBox1.ListIndex > -1 Then

   varTemp(3) = ListBox1.Value

   varTemp(4) = ListBox1.ListIndex

 End If

End Sub



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

 With ListBox1

   If .ListIndex > -1 And varTemp(2) <> "" Then

     If varTemp(4) <> varTemp(2) Then

       'wenn getauscht werden soll

       '.List(vartemp(4)) = vartemp(1)

       '.List(vartemp(2)) = vartemp(3)

       

       'wenn verschoben werden soll

       .RemoveItem varTemp(2)

       .AddItem varTemp(1), varTemp(4)

       .ListIndex = -1

       .MousePointer = fmMousePointerNoDrop

     Else

       .MousePointer = fmMousePointerDefault

     End If

   End If

   Erase varTemp

 End With

End Sub



Private Sub UserForm_Initialize()

 With ComboBox1

   .AddItem "BA1"

   .AddItem "BA2"

   .AddItem "BA3"

   .AddItem "BA4"

 End With

End Sub