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

Version imprimable

Voir 40 message(s) de cette discussion en une page

ben ma foi :

Code:

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 :lol:
un peu bizarre à "piger", non ?? :lun:

03/04/2006, 12h35
jmfmarques

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

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:

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:

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?!)

03/04/2006, 12h52
jmfmarques
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:

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
03/04/2006, 12h58
bandit boy

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 ...
03/04/2006, 13h03
jmfmarques

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 ? :?:
03/04/2006, 13h08
bandit boy

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
03/04/2006, 13h09
jmfmarques

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 ? :idea:

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 :cry:

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:

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)

03/04/2006, 15h16
jmfmarques

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...) :wink:
03/04/2006, 15h18
jmfmarques

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 !

pour l'instant j'ai ceci :
Code:

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 :

Citation:

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 ...

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

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:

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 !

03/04/2006, 16h32
bandit boy

désolé d'insister mais lorsque j'utilise ce que tu me conseille cela ne marche pas!! :cry: 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)
03/04/2006, 16h46
jmfmarques

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à .... :wink:
03/04/2006, 16h53
bandit boy

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

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 :pleure: ), ce qui donne :
Code:

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 :lol:

04/04/2006, 09h10
bandit boy

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
04/04/2006, 10h31
jmfmarques

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 + :wink:
04/04/2006, 10h53
bandit boy

OK, tout est pret pour ton retour :D

Voir 40 message(s) de cette discussion en une page