[VBA-E] réaliser un glisser-déplacer dans une listbox [Trucs & Astuces]

**jmfmarques** · 03/04/2006, 10h53

ben ma foi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private jmfcoucou As Boolean
Private Sub arrivee_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Not jmfcoucou Then Exit Sub
  arrivee.Text = arrivee.Text & copie.Caption
  copie.Visible = False
  jmfcoucou = False
End Sub
 
Private Sub depart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  With copie
    .Caption = depart.Text
    .Left = X + depart.Left
    .Top = Y + depart.Top
    .Drag (1)
    .Visible = True
  End With
  jmfcoucou = True
End Sub
 
Private Sub Form_Activate()
 copie.ZOrder
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then
    With copie
      .Left = X
      .Top = Y
    End With
  End If
  copie.Visible = False
  copie.Caption = ""
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  copie.Visible = False
End Sub

essaye

un peu bizarre à "piger", non ??

**jmfmarques** · 03/04/2006, 11h35

et alors, bandit ?
je croyais que tu étais impatient !
(je vais l'être de nouveau pour une bonne heure, en ce qui me concerne)

:

**bandit boy** · 03/04/2006, 11h45

j'ai du faire quelques modifications car VBA-E ne connait pas .drag (1),
Voici mon changement (jespère que c'est dans le meme esprit) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub depart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With copie
    .Caption = depart.Text
    .Left = X + depart.Left
    .Top = Y + depart.Top
    '.Drag (1)
    .Visible = True
  End With
  depart.DragBehavior = 1
  jmfcoucou = True
End Sub

sinon le glisser /deplacer fonctionne. Un petit point qui m'échappe : pourquoi ces deux lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
    .Left = X + depart.Left
    .Top = Y + depart.Top

Est ce pour le déplacement du cadre? (auquel cas le mien ne bouge pas?!)

**jmfmarques** · 03/04/2006, 11h52

là tu me poses une colle (si VBA n'a pas .drag !)
mais si ( ? ) .dragbehaviour lui correspond, il faut le mettre avec copie et pas, comme tu l'as fait, avec départ !
donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
With copie
    .Caption = depart.Text
    .Left = X + depart.Left
    .Top = Y + depart.Top
    .DragBehavior = 1
 
    .Visible = True
  End With
  depart  jmfcoucou = True

C'est sur copie que le drag s'effectue ... pas sur depart.
Ton cadre ne risque pas de se déplacer sans ce drag là
essaye et dis

**bandit boy** · 03/04/2006, 11h58

d'après l'aide : dragbehavior valide la fonction glisser-déplacer pour un contrôle TextBox ou ComboBox, c'est pourquoi je l'ai mis avec depart.

Je n'ai malheureusement rien trouvé de semblable en ce qui concerne les cadres

il reste cependant les fonctions beforedragover et beforedragorpaste mais après ca risque de plus etre dans l'esprit de ton programme ...

**jmfmarques** · 03/04/2006, 12h03

Bon ! je vais réfléchir à une autre méthode adaptée à VBA, mais ce sera beaucoup moins beau comme code, hélàs !
Mais dis-moi déjà : le contenu de depart est bien déposé dans arrivée au "lacher", au moins ?

:

**bandit boy** · 03/04/2006, 12h08

une fois la modification faite, en effet le texte de depart est bien mis dans arrivee, donc le principe fonctionne.
Je vais mabsenter pendant une bonne heure. encore merci pour l'attention que tu portes a mon problème !

a bientot

**jmfmarques** · 03/04/2006, 12h09

Minute !
Je viens d'essayer avec une textbox au lieu d'un cadre (pour copie)
et en modifiant bien sur partout copie.caption par copie.text
Il accepte le déplacement en 1er plan de la textbox.

peux-tu essayer avec VBA (j'ai pas) et en lui appliquant (à copie) le dragbehaviour de VBA, pour voir ?

**bandit boy** · 03/04/2006, 14h07

malheuresement ca n'a pas l'air de fonctionner. la valeur est bien mise dans copie, mais la textbox ne bouge pas, et le glisser/déplacer ne fonctionne plus

En fait après quelques essais, je me rends compte que depart.dragbehavior =1 est obligatoire pour autoriser le glisser/déplacer.
En revanche, la textbox bouge correctement lorsque je place le code comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Private Sub depart_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
    If Button = 1 Then
        With copie
        .Left = X + depart.Left
        .Top = Y + depart.Top
        End With
    End If
End Sub

mais pas lorsque j'utilise la fonction glisser/déplacer (dans ce cas la textbox rest immobile)

**jmfmarques** · 03/04/2006, 14h16

Je vois mal :
Montre-moi :
1) l'intégralité de ton code (pour le petit projet avec 2 textboxes)
2) ce que dit l'aide VBA pour dragbehaviour
s'il te plait !
si ne marche vraiment pas avec VBA, je ferai autre chose (moins beau, mais...)

**jmfmarques** · 03/04/2006, 14h18

Autre chose : peux-tu te contenter, en lieu et place du glisser du text, d'une modification sgnificative du curseur pendant le glisser-déposer ?
Ce serait peut-être plus beau !

**bandit boy** · 03/04/2006, 14h31

pour l'instant j'ai ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Private Sub arrivee_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Not jmfcoucou Then Exit Sub
    arrivee.Text = arrivee.Text & copie.Text
     copie.Visible = False
    jmfcoucou = False
End Sub
 
Private Sub depart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With copie
    .Text = depart.Text
    .Left = X + depart.Left
    .Top = Y + depart.Top
    .Visible = True
  End With
  depart.DragBehavior = 1
  jmfcoucou = True
End Sub
 
 
Private Sub depart_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
    If Button = 1 Then
        With copie
        .Left = X + depart.Left
        .Top = Y + depart.Top
        End With
    End If
End Sub
 
Private Sub UserForm_Activate()
    copie.ZOrder
End Sub
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
    With copie
      .Left = X
      .Top = Y
    End With
  End If
  copie.Visible = False
  copie.Text = ""
End Sub
 
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    copie.Visible = False
End Sub

dans l'aide j'ai ceci :

dragbehavior Spécifie si le système valide la fonction glisser-déplacer pour un contrôle TextBox ou ComboBox.

Syntaxe
object.DragBehavior [= fmDragBehavior]

fmDragBehavior= 0 Ne permet par une action glisser-déplacer (par défaut).
fmDragBehavior =1 Permet une action glisser-déplacer.

Remarques

Si la propriété DragBehavior est activée, le déplacement dans une zone de texte ou une liste modifiable commence une opération glisser-déplacer sur le texte sélectionné. Si DragBehavior est désactivé, le déplacement dans une zone de texte ou une liste modifiable sélectionne le texte.

La partie déroulante d'un contrôle ComboBox ne supporte ni la fonction glisser-déplacer, ni la sélection d'une partie du texte des éléments de la liste.

DragBehavior n'a aucun effet sur un contrôle ComboBox dont la propriété Style a la valeur fmStyleDropDownList.

Note Vous pouvez combiner les effets des propriétés EnterFieldBehavior et DragBehavior pour créer un grand nombre de styles de zone de texte.

Sinon, en effet je ne pense pas que ce soit indispensable la textbox qui se promène avec l'intitulé, donc avec juste un curseur différent ca fera parfaitement l'affaire.
C'est d'ailleurs actuellement le cas (peut etre géré par VBA??) : lorsque j'ai mon bouton gauche enfoncé pour glisser mon intitulé et que je déplace ma souris j'ai soit un sigle "interdiction" quand je sors de mes textbox, soit une flèche avec un petit carré en dessous lorsque je survole une textbox ...

**jmfmarques** · 03/04/2006, 15h16

Mais ...
tu insistes avec ton drag sur départ ! essaye avec copie :
remplaces, pour essayer ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
With copie 
    .Text = depart.Text 
    .Left = X + depart.Left 
    .Top = Y + depart.Top 
    .Visible = True 
  End With 
  depart.DragBehavior = 1 
  jmfcoucou = True

par celà :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
With copie 
    .Text = depart.Text 
    .Left = X + depart.Left 
    .Top = Y + depart.Top 
    .Visible = True 
    .DragBehavior = 1  '<<<<<<<<< ICI !!!
  End With 
    jmfcoucou = True

sans quoi l'essai ne veut rien dire !

dis moi, de sorte à ce que je ne cherche pas autre chose pour VBA pour rien !

**bandit boy** · 03/04/2006, 15h32

désolé d'insister mais lorsque j'utilise ce que tu me conseille cela ne marche pas!!

ou alors il faut que je sélectionne a nouveau le libelé de la textbox copie et effectuer a partir de la le glisser/déplacer.

Si je ne mets pas le dragbehavior sur depart, je ne peux pas sélectionner la valeur pour la déplacer ensuite

c'est pourquoi je suis resté sur le dernier bout de code qui lui fontionne ( si l'on a pas besoin du déplacement de copie)

**jmfmarques** · 03/04/2006, 15h46

Bon ! on va alors devoir abandonner le "trimballage" avec VBA.
Le reste marchant bien, celà va aller quand-même.
On va donc simplement essayer de faire "plus beau"
Je vais sortir maintenant (retour dans 2 heures)
En attendant :
Dans les propriétés de ta "Form" sous VBA as-tu :
- la propriété MouseIcon ?
- la propriété MousePointer ? et accepte-elle la valeur 99 (custom) ?
Ce sont 2 réponses que j'attends là ....

**bandit boy** · 03/04/2006, 15h53

je confirme : sous vba j'ai bien les propriétés MouseIcon et MousePointer (que je peux mettre a 99)

**jmfmarques** · 03/04/2006, 18h53

Bonne nouvelle !
mais nous n'allons même pas nous servir, finalement, de la valeur 99.
Comme, par ailleurs, la propriété.drag n'est pas dans VBA, nous allons également en profiter pour alléger du code devenu inutile (méphisto en profitera par contre, sous VB).
Celà me fait un peu de peine pour toi (c'était plus "pro") et pour moi (je zigouille la variable jmfcoucou

), ce qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub arrivee_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Me.MousePointer <> 5 Then Exit Sub
  arrivee.Text = arrivee.Text & copie.Caption
  depart.Text = ""
  copie.Visible = False
  Me.MousePointer = 0
End Sub
 
Private Sub depart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button <> 4 Then Exit Sub
  With copie
    .Caption = depart.Text
    .Left = X + depart.Left
    .Top = Y + depart.Top
    .Visible = True
  End With
  Me.MousePointer = 5
End Sub
 
Private Sub Form_Activate()
 copie.ZOrder
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  copie.Visible = False
  copie.Caption = ""
  Me.MousePointer = 0
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  copie.Visible = False
End Sub

Comment çà fonctionne ?
Si tu veux faire glisser-coller :
dans la textebox depart, appui du bouton central de ta souris, maintenu pressé jusqu'à le relacher dans la textbox arrivee.

Si tu préfères le bouton droit, dis-le. J'ai choisi le bouton central pour lever toute ambiguïté avec un clic éventuel.
Autre précision : j'ai laissé le "petit affichage" de départ, car il me parait plus rassurant pour l'utilisateur, qui peut "voir" qu'il ne s'est pas trompé d'endroit en pressant sa souris.
Si tu ne veux pas de ce petit plus, on supprime et on remplace par une variable (fastoche)
Si tout celà te convient, je me mets au travail pour les repérages entre 2 listboxes..
Tu dis donc

**bandit boy** · 04/04/2006, 08h10

je viens juste de tester ton programme et c'est nikel !! merci beaucoup
Pour le cadre on peut le laisser comme ca y'a pas de souci
Vivement les listbox, encore merci
a bientot

**jmfmarques** · 04/04/2006, 09h31

OK bandit, bonjour !

Je vais être absent pendant 3 heures mais ne t'oublie pas...
Prépare le même petit projet qu'hier mais avec 2 listboxes, cette fois-ci, nommées list1 et list2, avec, dans list1, quelques articles (5 ou 6) dans la liste..
A +

**bandit boy** · 04/04/2006, 09h53

OK, tout est pret pour ton retour

[VBA-E] réaliser un glisser-déplacer dans une listbox [Trucs & Astuces]

Macros et VBA Excel

Discussions similaires

Partager

Partager