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
Bonsoir.
Il devrait être possible de déplacer un Label en utilisant son évènement MouseMove.
Dans un petit UserForm muni d'un Label Label1 ceci marche :
VB:
Option Explicit
Dim 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)
   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
 
Dernière édition:

A2H

XLDnaute Nouveau
Bonsoir.
Il devrait être possible de déplacer un Label en utilisant son évènement MouseMove.
Dans un petit UserForm muni d'un Label Label1 ceci marche :
VB:
Option Explicit
Dim 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)
   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
Merci beaucoup pour la réponse, mais je veux le déplacer avec la souris (pointer, glisser, placer) drag & drop
 

A2H

XLDnaute Nouveau
Bonsoir.
Il devrait être possible de déplacer un Label en utilisant son évènement MouseMove.
Dans un petit UserForm muni d'un Label Label1 ceci marche :
VB:
Option Explicit
Dim 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)
   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
Merci beaucoup Dranreb pour votre aide le problème est régler pour le déplacement du label. Je v eux maintenant le déposer dans un textbox si vous avez une idée
Encore Merci
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Comme dit, il est possible que les évènements BeforeDragOver et BeforeDropOrPaste permettent de gérer tout ça, mais je n'ai aucune idée de comment ça marche.
Sinon, il serait toujours possible d'écrire une _MouseUp qui détecte de quelle TextBox le Label est le plus proche et affecte son .Caption à sa .Text et le remet à une position nominale
 

Lone-wolf

XLDnaute Barbatruc
Re

@A2H : il faut double cliquer sur la feuille pour afficher le formulaire, je l'ai pourtant bien mentionné.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour Lone-wolf
Oui ça marche. Je ne sais pas comment mais la partie copie du Caption marche.
Il ne reste plus qu'à voir si on peut combiner ça au glissement visible du Label…
 

Lone-wolf

XLDnaute Barbatruc
Re Dranreb

@Dranreb

C'est cette partie qui mémorise le texte de chaque Label

Set D = New DataObject
D.SetText Txt 'Txt variable label.caption
Effect = D.StartDrag

Le mieux ce serait un module de classe, si plus de contrôles; mais je ne sais pas faire.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Oui je m'en doutais un peu. J'ai vu aussi qu'il suffisait de le faire une seule fois au MouseDown. Je suis donc en train de chercher à utiliser le MouseMove pour déplacer le Label. Mais ça ne marche pas pour l'instant, et j'ai peur que quand ça marchera le relâchement ne sera pas perçu pour la TextBox cible parce que le pointeur sera sur le Label…
 

A2H

XLDnaute Nouveau
Merci beaucoup Dranreb pour votre collaboration
Concernant le fichier, j'ai déjà cliquer 2 fois (j'ai vu la remarque), il s'ouvre mais il est vide
 

Lone-wolf

XLDnaute Barbatruc
le relâchement ne sera pas perçu pour la TextBox cible parce que le pointeur sera sur le Label
Oui, puisque c'est géré (en quelque sorte) par le pointeur.

@A2H: tu as quoi comme version excel. Mais normalement, il devrais s'afficher. Sinon va dans le projet VBA et clique sur le petit bouton vert pour voir.
 

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
Je me suis souvenu que le clic n'a lieu qu'au relâchement du bouton de la souris, et il s'avère que le même code mais dans une Label1_Click au lieu de la Label1_MouseUp marche beaucoup mieux.
 

Discussions similaires


Haut Bas