glisser déposer un objets dans un userform (VBA)

A2H

XLDnaute Nouveau
Bonsoir
Je veux savoir s'il est possible de créer un code VBA pour glisser déposer un objet (Text, image) dans un userform), comme la cas d'un puzzle
exemple j'ai 3 textes et 3 TextBox et je veux deplacer avec la souris le text1 dans le textBox 3 , le texte2 dans le textbox1 …
Merci d'avance
 

Dranreb

XLDnaute Barbatruc
Les évènements des TextBox, derrière, marchent toujours à un détail près avec ce code pour le Label1:
VB:
Private LabLeft As Single, LabTop As Single, X0 As Single, Y0 As Single
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   LabLeft = Label1.Left: LabTop = Label1.Top
   X0 = X: Y0 = Y
   End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      If Button = 0 Then Exit Sub
      Label1.Left = Label1.Left + X - X0
      Label1.Top = Label1.Top + Y - Y0
      End Sub
'Private Sub Label1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Private Sub Label1_Click()
   Label1.Left = LabLeft: Label1.Top = LabTop
   With New MSForms.DataObject: .SetText Label1.Caption: .StartDrag: End With
   End Sub
Le détail près c'est que ça ne se fait que lorsqu'on bouge la souris après avoir relâché le bouton.
Édition: mais plus maintenant.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Pourquoi n'aurais tu pas su faire ce que je propose au poste #21 ? Quels mystères particuliers y a-t-il là dedans pour toi ? Si je puis répondre de quelque façon à compléter tes bases…
Écris donc une classe TBxCiblePossible si tu veux…
 

Dranreb

XLDnaute Barbatruc
Cela t'empêche-t-il d'accroitre ton expérience en essayant ?
De mon coté je l'ai fait, et la programmation de l'UserForm de test se résume à ça :
VB:
Option Explicit
Private Cln As New Collection

Private Sub UserForm_Initialize()
Dim LGe As LabelGlissable, TPe As TextBoxCiblePossible, Cnl As MSForms.Control
For Each Cnl In Me.Controls
   If TypeOf Cnl Is MSForms.Label Then
      Set LGe = New LabelGlissable: Set LGe.Lab = Cnl
      Cln.Add LGe
   ElseIf TypeOf Cnl Is MSForms.TextBox Then
      Set TPe = New TextBoxCiblePossible: Set TPe.TBx = Cnl
      Cln.Add TPe
      End If: Next Cnl
End Sub
 

Lone-wolf

XLDnaute Barbatruc
Re Dranreb

Pour toi ça coule comme l'eau de roche (vu le progès Gygogne). Mais pour moi c'est une autre histoire. J'ai déjà du mal avec de simples macros, imagine les modules de classe; j'ai beaucoup de peine à assimiler tout ça.

Je sais que l'on peut mettre l'évènement du label directement dans celui-ci (M de C), mais après ?? :rolleyes:
 

Dranreb

XLDnaute Barbatruc
Il faut clarifier les concepts VBA je crois. Tu ne devrais plus te poser de question comme l'autre jour du genre pourqoi une expression String variable ne se spécifie pas avec des double apostrophes à une procédure à laquelle on transmet le plus souvent une constante String comme paramètre. Il faut y aller petit à petit. Je suis toujours prêt à préciser des concepts. Après ce n'est plus qu'un jeu de construction de les combiner comme on veut.
Je crois vaguement que beaucoup de gens ont beaucoup de mal avec la notion d'objet. C'est peut être parce qu'ils ont tendance, pour se raccrocher à des comparaisons naturelles, à les confondre avec ce que j'appelle les entités Excel que ces objet ont souvent pour rôle de représenter. L'objet qui intéresse l'électricien c'est le boitier de commande du gigantesque pont roulant d'atelier, ce n'est pas ce dernier, même s'il n'y a qu'une identification de la machine écrite dessus, parce que ça n'apporterait rien d'y préciser que ce n'en est que l'organe de commande !
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re

Pas tout compris, mais ce n'est pas grave. Voici ce que j'ai mis dans le module de classe que jai nommé GroupControls(si j'ai bien compris).

VB:
Option Explicit

Public WithEvents GroupeLbl As MSForms.Label
Public WithEvents GroupeTb As MSForms.TextBox
Dim i&, Txt$, D As Object, Effect


Private Sub GroupeLbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal x As Single, ByVal Y As Single)

    If Button = 1 Then
        For i = 1 To 3
            Txt = GroupeLbl.Caption
        Next i
        Set D = New DataObject
        D.SetText Txt
        Effect = D.StartDrag
    End If
End Sub

Private Sub GroupeTb_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 GroupeTb_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal x As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    Cancel = True
    Effect = 1

    GroupeTb.Value = Data.GetText
End Sub

Et dans l'USF

VB:
Option Explicit

Dim Lbl(1 To 3) As New GroupControls
Dim Tb(1 To 3) As New GroupControls

Private Sub UserForm_Initialize()
Dim i&, k&

    For i = 1 To 3
            Set Lbl(i).GroupeLbl = Me.Controls("Label" & i)
    Next i

    For k = 1 To 3
            Set Tb(k).GroupeTb = Me.Controls("Textbox" & k)
    Next k

End Sub
 

Pièces jointes

  • Classeur exemple-V2.xlsm
    21.9 KB · Affichages: 26
Dernière édition:

Dranreb

XLDnaute Barbatruc
Eviter Collection comme nom de module de classe: c'est déjà un type de donnée VBA.
Je préconisais TextBoxCiblePossible et c'est indépendant de LabelGlissable puisque n'importe quel label peut être glissé vers n'importe quelle TextBox. Dans l'UserForm une seule collection suffit pour stocker les objets des deux types. Sont rôle n'est que de veiller à ce que les adresses vers ces exemplaires d'objets soient conservées quelque part, sinon ils sont fusillés d'office.
 

Discussions similaires

Réponses
12
Affichages
393