Clever-Excel-Forum › Office-Anwendungen › Excel v
UF - Drag&Drop?

Thema geschlossen 
Baumstrukturmodus
UF - Drag&Drop?
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#11
13.04.2019, 11:40
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.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Homepage Suchen
Top
00202
Nicht registrierter Gast
 
#12
13.04.2019, 12:43
(13.04.2019, 11: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:
Top
Flotter Feger Offline
Ich versuche gut auszusehen
Registriert seit: 03.10.2018
Version(en): 2010 ProPlus / 2016 ProPlus
#13
13.04.2019, 14:51
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 ...
Suchen
Top
00202
Nicht registrierter Gast
 
#14
13.04.2019, 15:07
Hallo Sabina, :19:

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

Drag & Drop...
[-] Folgende(r) 2 Nutzer sagen Danke an Gast für diesen Beitrag:
  • Der Steuerfuzzi, EasY
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#15
13.04.2019, 16:54
Hi Ralf,

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

Gruß Uwe
Suchen
Top
00202
Nicht registrierter Gast
 
#16
13.04.2019, 20:38
(13.04.2019, 16:54)Kuwer schrieb: Hi Ralf,

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

Gruß Uwe

Hallo Uwe, :19:

Ein- zwei Hefeweizen - dann klappt das. :21:
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#17
13.04.2019, 20:43
(13.04.2019, 20:38)Case schrieb: Ein- zwei Hefeweizen - dann klappt das. :21:

:26:  :26:
Suchen
Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#18
13.04.2019, 22:13
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 Sad 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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Homepage Suchen
Top
00202
Nicht registrierter Gast
 
#19
14.04.2019, 09:59
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:
Top
schauan Offline
Einer von hier
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
#20
14.04.2019, 10:30 (Dieser Beitrag wurde zuletzt bearbeitet: 14.04.2019, 10:45 von schauan.)
Hallo Ralf,

nicht ganz … Das Original ist, wenn ich nix übersehen hab, nur zum Selectieren Sad
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 Sad
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 Sad
Aber, wie ich schon weiter oben schrieb, wäre mir eine Lösung mit TextBoxen die liebste Smile

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
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Homepage Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste