UF - Drag&Drop?

[schauan]

Hallöchen,

wie schon geschrieben wurde, geht es nicht mit Drag&Drop (bisschen Drag&Drop geht nur im ListView).

Alternativen wären noch die Verwendung zweier Listboxen, wo Du die Namen aus der einen in die andere in gewünschter Reihenfolge schiebst. Da schiebst Du zuerst den neuen Leiter rein und dann mit Multiselect den Rest.

Besser wären eventuell zusätzliche Textboxen zur Änderung. Du wählst in der Liste einen Namen, der erscheint mit weiteren Eigenschaften in verschiedenen TextBoxen und dort gibst Du den Status bzw. die Zuordnung ein.

[Case]

Hallöchen,

wie schon geschrieben wurde, geht es nicht mit Drag&Drop...

Hallo André, :19:

wer schreibt sowas? :21:

Die ListBox einer UserForm kennt doch die Ereignisse...

• BeforeDropOrPaste
  
• BeforeDragOver
  
• MouseMove
  

Damit sollte es möglich sein "Items" per Maus zu verschieben - also Drag & Drop. :21:

[Flotter Feger]

Hallo Case,

wie willst du dabei das Problem der genauen Mauskoordinaten innerhalb der Listbox lösen ?
Irgendwie musst du Excel schließlich sagen, wo es das Drop durchführen soll ...

[Case]

Hallo Sabina, :19:

bezogen auf den "TopIndex", die Position "Y" und die "Schriftgröße". :21:

Drag & Drop...

[Kuwer]

Hi Ralf,

hab mal damit gespielt. Aber die Zielgenauigkeit ist leider nicht so toll.

Gruß Uwe

[Case]

Hi Ralf,

hab mal damit gespielt. Aber die Zielgenauigkeit ist leider nicht so toll.  

Gruß Uwe

Hallo Uwe, :19:

Ein- zwei Hefeweizen - dann klappt das. :21:

[Kuwer]

Ein- zwei Hefeweizen - dann klappt das. :21:

:26:  :26:

[schauan]

Hi Ralf,

ich ha hier mal MouseDown und MouseUp vergewaltigt...
Das verlinkte Drag&Drop hab ich noch nicht ausprobiert, wird ich dann noch machen.
War erst mal etwas voreingenommen, MouseMove wirkt ja schon, sobald Du irgendwo die Fläche der Listbox betrittst.

Ich hab hier die rechte Maustaste genommen. Ist vielleicht auch noch nicht 100%, aber auch schon recht spät heute Basis ist ein Userform mit einer ListBox1.

Option Explicit

Private m_sngLBRowHeight  As Single
Dim lDown As Long, lUp As Long, boEnter As Boolean

Private Sub ListBox1_Enter()
    'Verschieben nur bei Mauszeiger innerhalb Listbox 
    boEnter = True
End Sub

Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    'Verschieben nur bei Mauszeiger innerhalb Listbox 
    boEnter = False
End Sub

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim lngListRow As Long
    'Wenn rechter Button gedrueckt, dann 
    If Button = 2 Then
        'Position ermitteln 
        lngListRow = (Y / m_sngLBRowHeight) + ListBox1.TopIndex - 1
        If lngListRow > (ListBox1.ListCount - 1) Then lngListRow = ListBox1.ListCount - 1
        'Eintrag selectieren 
        ListBox1.Selected(lngListRow) = True
        'Indexnummer sichern 
        lDown = lngListRow
    'Ende Wenn rechter Button gedrueckt, dann 
    End If
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim lngListRow As Long
    Dim str1 As String, str2 As String
    'Wenn rechter Button gedrueckt, dann 
    If Button = 2 And boEnter Then
        'Position ermitteln 
        lngListRow = (Y / m_sngLBRowHeight) + ListBox1.TopIndex - 1
        If lngListRow > (ListBox1.ListCount - 1) Then lngListRow = ListBox1.ListCount - 1
        'Eintrag selectieren 
        ListBox1.Selected(lngListRow) = True
        'Indexnummer sichern 
        lUp = lngListRow
        'Eintrag verschieben 
        str1 = ListBox1.List(lDown)
        str2 = ListBox1.List(lUp)
        ListBox1.List(lDown) = str2
        ListBox1.List(lUp) = str1
    'Ende Wenn rechter Button gedrueckt, dann 
    End If
End Sub

Private Sub UserForm_Activate()
    Dim sngOldHeight
    If m_sngLBRowHeight = 0 Then
        With ListBox1
            .TopIndex = .ListCount - 1
            sngOldHeight = .Height
            Do While .TopIndex = 0
                .Height = .Height - 10
                .TopIndex = .ListCount - 1
            Loop
            m_sngLBRowHeight = .Height / (.ListCount - .TopIndex + 1)
            .Height = sngOldHeight
            .TopIndex = 0
        End With
    End If
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .Height = 80  '130 
        .AddItem "Zero"
        .AddItem "One"
        .AddItem "Two"
        .AddItem "Three"
        .AddItem "Four"
        .AddItem "Five"
        .AddItem "Six"
        .AddItem "Seven"
        .AddItem "Eight"
        .AddItem "Nine"
        .AddItem "Ten"
        .IntegralHeight = True
    End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

[Case]

Hallo André, :19:

das hat Andy damals auf Ozgrid schon so gemacht: :21:

Select index in listbox whith MouseDown (right click)...

Ist aber das gleiche Problem wie bei Dick. Eine ganz sauber arbeitende Lösung wird man da wohl nicht hinbekommen.

Es ist wie immer - es gibt mal wieder mehrere Lösungen. Der Eine arbeitet lieber mit der Maus, der Nächste mit der Tastatur und der Andere mit einem SpinButton (Drehfeld). Solange keiner seine Lösung als die "Einzig Glücklich Machende" anpreist ist alles in Butter. :05:

[schauan]

Hallo Ralf,

nicht ganz … Das Original ist, wenn ich nix übersehen hab, nur zum Selectieren
Ich hab den Teil mit dem MouseDown und Up anders umgesetzt. Allerdings bin ich insgesamt nicht ganz auf der Linie. Ich hab die Einträge getauscht statt nur einen zu verschieben
Hier hab ich das gerade mal noch angepasst um die Aktion auch seitlich auf den Bereich der Listbox einzugrenzen.
Damit kann ich jetzt auch auf allen Seiten außerhalb loslassen und es passiert nix. Anders könnte man das sonst kaum abbrechen
Aber, wie ich schon weiter oben schrieb, wäre mir eine Lösung mit TextBoxen die liebste

Code:

Option Explicit

Private m_sngLBRowHeight  As Single
Dim lDown As Long, lUp As Long, boEnter As Boolean

Private Sub ListBox1_Enter()
   'Verschieben nur bei Mauszeiger innerhalb Listbox
   boEnter = True
End Sub

Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim lngListRow As Long
   'Wenn rechter Button gedrueckt, dann
   If Button = 2 Then
       'Position ermitteln
       lngListRow = (Y / m_sngLBRowHeight) + ListBox1.TopIndex - 1
       If lngListRow > (ListBox1.ListCount - 1) Then lngListRow = ListBox1.ListCount - 1
       'Eintrag selectieren
       ListBox1.Selected(lngListRow) = True
       'Indexnummer sichern
       lDown = lngListRow
   'Ende Wenn rechter Button gedrueckt, dann
   End If
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Verschieben nur bei Mauszeiger innerhalb Listbox
If X < 0 Or Y < 0 Or X > ListBox1.Width Or Y > ListBox1.Height Then
 boEnter = False
Else
 boEnter = True
End If
'Cells(1, 1) = X
'Cells(1, 2) = Y
'Cells(2, 1) = ListBox1.Left
'Cells(3, 1) = ListBox1.Width
'Cells(2, 2) = ListBox1.Top
'Cells(2, 3) = ListBox1.Height
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim lngListRow As Long
   Dim str1 As String, str2 As String
   'Wenn rechter Button gedrueckt, dann
   If Button = 2 And boEnter Then
       'Position ermitteln
       lngListRow = (Y / m_sngLBRowHeight) + ListBox1.TopIndex - 1
       If lngListRow < 0 Then lngListRow = 0
       If lngListRow > (ListBox1.ListCount - 1) Then lngListRow = ListBox1.ListCount - 1
       'Eintrag selectieren
       ListBox1.Selected(lngListRow) = True
       'Indexnummer sichern
       lUp = lngListRow
       'Eintrag verschieben
       str1 = ListBox1.List(lDown)
       str2 = ListBox1.List(lUp)
       ListBox1.List(lDown) = str2
       ListBox1.List(lUp) = str1
   'Ende Wenn rechter Button gedrueckt, dann
   End If
End Sub

Private Sub UserForm_Activate()
   Dim sngOldHeight
   If m_sngLBRowHeight = 0 Then
       With ListBox1
           .TopIndex = .ListCount - 1
           sngOldHeight = .Height
           Do While .TopIndex = 0
               .Height = .Height - 10
               .TopIndex = .ListCount - 1
           Loop
           m_sngLBRowHeight = .Height / (.ListCount - .TopIndex + 1)
           .Height = sngOldHeight
           .TopIndex = 0
       End With
   End If
End Sub

Private Sub UserForm_Initialize()
   With ListBox1
       .Height = 80
       .AddItem "Zero"
       .AddItem "One"
       .AddItem "Two"
       .AddItem "Three"
       .AddItem "Four"
       .AddItem "Five"
       .AddItem "Six"
       .AddItem "Seven"
       .AddItem "Eight"
       .AddItem "Nine"
       .AddItem "Ten"
       .IntegralHeight = True
   End With
End Sub