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

Dranreb

XLDnaute Barbatruc
À terme ça pourrait fini par faire beaucoup de procédures, et un module de classe pour simplifier ça ne serait peut être pas de trop.
 

Fichiers joints

Lone-wolf

XLDnaute Barbatruc
Re

C'est ce que j'ai dit dans mon précédent message, beaucoup plus facile à gérer. Mais moi, pas savoir faire. :oops:
 

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…
 

Lone-wolf

XLDnaute Barbatruc
Re Dranreb

Personnellement j'en ai pas un besoin particulier. C'est plus pour notre ami que je proposait un module de classe.
 

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
 

Fichiers joints

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.
 

Lone-wolf

XLDnaute Barbatruc
Re

J'ai renommé après coup le module comme tu peux le voir dans le code. Comme je ne savait pas à quoi se référaient les variables que tu à montré, jai fait autrement.
 

Dranreb

XLDnaute Barbatruc
Nom mais essaie de faire le module de classe TextBoxCiblePossible de tel sorte que le code donné poste #25 marche.
Il est plus simple que le LabelGlissable et est essentiellement avec des procédures de ton cru.
 

Lone-wolf

XLDnaute Barbatruc
Re

Alors là tu me pose une sacré colle dit donc. Tu veux m'envoyer chez les fous ou quoi?? :eek::D:D

EDIT: au faite, est-ce qu'elles sont de type LET et GET par hazard?:rolleyes:
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Mais non. Regarde comment est fait le module de classe LabelGlissable du Temp.xlsm joint poste #21 et fait à peu près pareil, mais en plus simple parce qu'il n'y a qu'une instruction à mettre dans la Property Set et ensuite tes deux Sub _BeforeDragOver et _BeforeDropOrPaste
Et s'il y a quelque chose que tu ne comprends pas au passage pose moi des questions.
 

Lone-wolf

XLDnaute Barbatruc
Re

Je n'ai pas regardé le post #21. En attendant ton message, j'ai créé 2 modules de classe un nommé TextBoxCible et l'autre LabelGlissable.

Mais je ne sais pas comment modifier la boucle For i par For each.
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
À mon avis il n'y a pas de raison de nommer GroupLabel le contrôle central du module de classe. Beaucoup le font et c'est complètement absurde parce que cette propriété représente une seul Label propre à l'exemplaire de l'objet et pas un groupe de Label ou je ne sais quoi.
J'avais demandé à ce que l'UserForm_Initialize telle que je l'avais écrite fonctionne avec tes modules de classe.
Alors s'il te plait appelle la propriété Label Lab et dans l'autre la TextBox TBx, c'est tout.
Il n'est pas utile que les variables LabelGlissable et TextBoxCible soient globales dans l'UserForm: elles ne sont utilisées que dans l'UserForm_Initialize et elles peuvent donc y être des variables locales.
Le module de classe LabelGlissable tel que je l'avais écrit, avec glissement visible, ça aussi j'y tiens :
VB:
Option Explicit
Private WithEvents LabI As MSForms.Label, Left As Single, Top As Single, X0 As Single, Y0 As Single
Public Property Set Lab(ByVal Lab As MSForms.Label)
   Set LabI = Lab
   Left = LabI.Left: Top = LabI.Top
   End Property
Private Sub LabI_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   X0 = X: Y0 = Y
   End Sub
Private Sub LabI_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   If Button = 0 Then Exit Sub
   LabI.Left = LabI.Left + X - X0
   LabI.Top = LabI.Top + Y - Y0
End Sub
Private Sub LabI_Click()
   LabI.Left = Left: LabI.Top = Top
   With New MSForms.DataObject: .SetText LabI.Caption: .StartDrag: End With
   End Sub
 

Dranreb

XLDnaute Barbatruc
Eh ben voilaaaaaa !
Bon je l'avais écrite comme ça parce que je ne vois pas l'utilité que la propriété TBx soit en lecture/écriture, mais ce n'est qu'un détail :
VB:
Option Explicit
Private WithEvents TBxI As MSForms.TextBox
Public Property Set TBx(ByVal TBx As MSForms.TextBox)
   Set TBxI = TBx
   End Property
Private Sub TBxi_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 TBxI_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
   TBxI.Text = Data.GetText
   End Sub
En tout cas ça marche comme tu l'as écrit :)
 

Lone-wolf

XLDnaute Barbatruc
Re

Encore une fois, merci Dranreb. ;)

Au faite, si au lieu du texte on utilise la propriété BackColor comme dans l'exemple que j'ai montré au post #20(ici il inscrit le numéro de la couleur, si je ne dis pas de bétises), comment faudrait procéder?
 
Dernière édition:

ChTi160

XLDnaute Barbatruc
Bonsoir Lone-wolf
Bonsoir Dranreb

juste une question
je ne comprends pas l'utilisation du
VB:
With New MSForms.DataObject:
Je comprends que cela a une relation avec les TextBox , mais je ne vois nulle part de référence a ces Trois TextBox.
Pourrais tu (Dranreb ou lone-wolf) m'expliquer l'utilisation de cette procédure .
Merci par avance
jean marie
 

Discussions similaires


Haut Bas