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.
(13.04.2019, 10:40)schauan schrieb: [ -> ]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:
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 ...
Hi Ralf,
hab mal damit gespielt. Aber die Zielgenauigkeit ist leider nicht so toll.
Gruß Uwe
(13.04.2019, 15:54)Kuwer schrieb: [ -> ]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:
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
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:
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