Discussion :

[jmfmarques]

OK, bandit !
Il va falloir toutefois que tu patientes encore un peu...
J'ai déjà reussi la gestion des index, mais je cherche à faire mieux. (le "coup" du sapeur Camembert... tu connais ?), avec moins de code ... Si j'y parviens, celà aura valu le coup d'attendre...

[jmfmarques]

Voilà, bandit !
Je pense que nous sommes tous les deux gagnants (moi, parceque j'ai réussi à insérer une variable jmfcoucou et toi, parce que le sapeur Camembert avait raison de faire des trous partout dans sa caserne )
J'avais dans un premier temps utilisé un tableau annexe, mais, grâce à Mossieu Camembert, nous avons pu éviter cette lourdeur !

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
49
50
51
52
53
54
55
56
Private jmfcoucou As String
 
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
 
Private Sub List1_Click()
 jmfcoucou = List1.Text
End Sub
 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 4 Then Exit Sub
  With copie
    .Caption = fmfcoucou
    .Left = X + List1.Left
    .Top = Y + List1.Top
    .Visible = True
  End With
  Me.MousePointer = 5
End Sub
 
Private Sub List2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dim hauteur As Integer
 If Me.MousePointer <> 5 Then Exit Sub
 If List2.ListCount < 2 Then
   List2.AddItem jmfcoucou
 Else
   Font = List2.Font
   With Font
    .Size = List2.FontSize
     hauteur = TextHeight(coucou)
   End With
   numind = Int(Y / hauteur) - 1
   If numind < 0 Then numind = 0
   List2.AddItem jmfcoucou
    DoEvents
  DoEvents
  For k = List2.ListCount - 1 To numind + 1 Step -1
    List2.List(k) = List2.List(k - 1)
  Next k
  List2.List(k) = jmfcoucou
  End If
  jmfcoucou = ""
  copie.Visible = False
  Me.MousePointer = 0
End Sub

Méthode : s'agissant d'une listbox, j'ai voulu ménager la chèvre et le choux et donc, permettre quand même la sélection d'un article au click !
Méthode pour glisser-coller :
1) cliquer sur l'article pour le sélectionner
2) le "saisir" ensuite (avec le bouton central) et le tranporter vers list2.
Dis-nous !

[bandit boy]

Aie! VBA-E ne connait la fonction textHeight!!

Est ce que tu peux m'expliquer l'utilité de la ligne, afin que je vois si j'ai un équivalent sous VBA :

Code :

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

1
2
 
hauteur = TextHeight(coucou)

(d'ailleurs pourquoi coucou ? ce ne doit pas etre jmfcoucou plutot??)

[jmfmarques]

faute de frappe c'est jmfcoucou, de même qu'ailleurs : changer fmfcoucou par jmfcoucou, bien sur.
Textheight ? il permet de connaître la hauteur occupée par chaque article, en fonction de la font de la listbox list2.
Tu peux en faire harakiri si tu acceptes, pour ta list2, une font et une taille (dis-les moi alors, et je calcule la valeur)
dis-moi !
EDIT : le nom de la font (police) également, STP

[bandit boy]

vu que pour l'instant je n'ai pas trouvé d'équivalent de textheight sous VBA,
jsui partant pour une valeur fixe (je crois que lorsque j'avais fait des essais j'avais dailleurs fixé 9 points comme taille)

[jmfmarques]

9 ? ok avec quelle Police ?

[bandit boy]

tahoma

[jmfmarques]

OK !

alors tu changes tout celà !

Code :

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

1
2
3
4
5
Font = List2.Font 
   With Font 
    .Size = List2.FontSize 
     hauteur = TextHeight(coucou) 
   End With

par

Code :

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

hauteur = 195

essayes et dis-moi !

[bandit boy]

pourquoi 195? quan je le mets, les valeurs s'ajoutent toujours en première position, par contre si je mets 9 cela fonctionne correctement

Mais j'en arrive a une limitation que j'avais rencontré : que se passe t'il si la list box contient un scrollbar : autrement dis si je veux mettre un item tout a la fin?
Actuellement ca le met en dernière position visible de ma listbox (lorsque que l'ascenceur est tout en haut)

Je suis désolé j'en demande énormément

[jmfmarques]

9 et pas 195 veut dire que VBA est en points alors que je suis en Twips (un gros mot pour VBA apparemment ! ). Bon : alors 9, dans ce cas.

L'histoire de la scrollBar, je l'attendais !

Résoluble également (juste un peu plus complexe, mais on va faire) !
Sinon : est-ce tout va bien avec VBA à part celà ?
Si je réussis à traiter également avec la scrollbar... quel champagne m'offres-tu ?

[bandit boy]

C'est super si maintenant tu devances mes questions
A part cela le profgramme fonctionne parfaitement bien sous VBA.

Je commence enfin a bien me familiariser avec cette application entre autres grace a votre aide précieuse (il y a un mois je ne connaissais srtictement rien a VBA!! )

[jmfmarques]

Bien que tu n'aies pas encore annoncé la couleur (du champagne), on va essayer tout bêtement celà (je n'ai pas essayé... à toi donc :...)
remplacer :

Code :

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

numind = Int(Y / hauteur) - 1

par

Code :

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

numind = (Int(Y / hauteur) - 1 ) + List2.topindex

juste pour voir...
dis-moi !

[bandit boy]

parfait!! la vraiment merci beaucoup!!! va falloir que j'y réfléfléchisse sérieusement au champagne

j'ose, j'ose pas... allez j'ose : une dernière petite question (mais c'est juste un bonus donc pas grave si il n'y a pas de soluce) :

Est ce compliqué de faire défiler automatiquement le scrollbar lorsque la souris est positionné en bas de la listbox?
Pour m'exprimer autrement : imaginons que le scroll de la list2 soit tout en haut et que l'on veuille mette une valeur en bas de la list2 (la valeur étant deja selectionné), sans lacher le bouton du milieu est t-il possible de faire descendre le scroll?

en tout cas encore merci pour toute ton aide !!

[jmfmarques]

OUI c'est également possible ! (C'est comme dans la pub de la MatMut "tout est possible, tout est réalisable")
Mais là, il va te falloir peut-etre être patient (tu me mets sur les rotules, bandit !)
pour l'instant et pour te rassurer :
N'aies aucun complexe car :
1) ce n'était pas facile du tout
2) nous aurions pu faire autrement (appel d'APIs) mais je tenais à faire avec ce que VBA (pour toi) et VB (pour d'autres) offraient seuls.
3) tu m'a mis à genoux
4) dans cette affaire, la gymnastique de l'esprit a été plus importante que la syntaxe (et même une fois le tout écrit, celui qui relira n'en comprendra certains mécanismes qu'au prix d'efforts. Un événement, attendu normalement dans un MouseUp, est exécuté dans un MouseMove...)


Je vais donc me mettre (demain) à ton autre machin, mais :

- Je vais de mon côté mettre tout çà au propre et commenté pour VB
- quand tout sera bon pour toi : fais-en autant avec VBA (au propre et avec commentaires) et communique ton résultat... car je pense que tu nous a fait faire là un exercice totalement inhabituel et qui peut être utile à beaucoup d'entre nous.

[jmfmarques]

Bonjour, Bandit...

Je vois et mesure la difficulté du "truc" à rajouter (une fois le bouton préssé, on ne connait plus la position de la souris sur la "Form", hein ?)
Nous pourrions résoudre avec APIs (c'est fait), mais nous allons tout mettre en oeuvre pour faire sans APIs (pour rester dans l'esprit de VB ou VBA seul).
Nous allons devoir quelque peu "nous casser la tête" avec quelques calculs compliqués, que j'entrevois déjà fort bien, puis décider d'actions de déroulement de la 2ème liste.
Et nous allons y parvenir, promis juré...
Je relève donc ce deuxième défi, et sans APIs
Juste une question te temps ... patientes donc un peu (et pense au champagne)

[bandit boy]

J'ai remis le code adapté VBA de jmfmarques au propre et commenté.
Pour rappel le userform doit contenir 2 listes (List1 et List2) et un cadre nommé copie. Un click gauche permet de sélectionner la valeur, et un appui prolongé sur le bouton du milieu permet le déplacement de la valeur sélectionnée dans list1 vers list2:

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 jmfcoucou As String
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)
    copie.Visible = False           'pas besoin de l'information de copie
    copie.Caption = ""
    Me.MousePointer = 0             'remet le pointeur par défaut
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           'cache copie (plus besoin de l'information)
End Sub
Private Sub List1_Click()
    jmfcoucou = List1.Text          'permet de récupérer la valeur de la donnée souhaitée
End Sub
Private Sub List1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button <> 4 Then Exit Sub    ' teste un appui sur le bouton du milieu
  With copie                        ' gère le déplacement et l'affichage de copie
    .Caption = jmfcoucou
    .Left = X + List1.Left
    .Top = Y + List1.Top
    .Visible = True
  End With
  Me.MousePointer = 5
End Sub
Private Sub List2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim hauteur As Integer
 If Me.MousePointer <> 5 Then Exit Sub
 If List2.ListCount < 2 Then         'ajoute après le premier terme (lorsqu'il n'y en a qu'un)
    List2.AddItem jmfcoucou
 Else
    Font = List2.Font
    hauteur = 9                      ' renseigne la hauteur des items
    numind = (Int(Y / hauteur) - 1) + List2.TopIndex + 1 'permet un bon indexage meme avec une scrollbar
    If numind < 0 Then numind = 0    'évite une valeur négative d'index (source d'erreur)
    List2.AddItem jmfcoucou
    DoEvents
    DoEvents
    For k = List2.ListCount - 1 To numind + 1 Step -1
        List2.List(k) = List2.List(k - 1)
    Next k
    List2.List(k) = jmfcoucou       'place la valeur à l'endroit souhaité
 End If
 jmfcoucou = ""
 copie.Visible = False
 Me.MousePointer = 0
End Sub

j'en ai profité de mon coté pour remettre mon premier code a jour. Je vous en fait donc part aussi. Il sert pour déplacer des items a l'interieur d'une meme liste. Pour cela vous avez besoin d'une liste nommée Listbox1. Un appui prolongé sur le bouton gauche permet de déplacer la valeur sélectionnée ou l'on veut dans la liste :

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
 
 
Private Sub listbox1_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                                       'autorise la gestion de l'évenement
    Effect = 1                                          'autorise la copie
End Sub
 
Private Sub listbox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean _
, ByVal Action As Long, ByVal Data As MSForms.DataObject, ByVal X As Single _
, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
Dim place As Integer
    Cancel = True                                       'autorise la gestion de l'évenement
    Effect = 1                                          'autorise la copie
    Me.ListBox1.RemoveItem Me.ListBox1.ListIndex        'efface la valeur avant de la re-déplacer (évite les doublons)
    place = Int(Y / 9) + ListBox1.TopIndex              'calcule le nouvel index de la valeur (9 est la largeur d'un de mes élements de la liste)
    If place > ListBox1.ListCount Or Y = Null Then place = ListBox1.ListCount 'si mauvais geste de l'utilisateur on place l'item en dernière position
    Me.ListBox1.AddItem Data.GetText, place             'copie de l'item a la nouvelle place
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Dim MyDataObject  As DataObject
  Dim Effect As Integer
  If Button = 1 Then                                    'bouton de gauche appuyé
    Set MyDataObject = New DataObject
    MyDataObject.SetText Me.ListBox1.Value              'mémorisation de la valeur à déplacer
    Effect = MyDataObject.StartDrag                     'permet la modification du pointeur durant l'opération
  Else
    If Me.ListBox1.ListCount > 0 Then
        Me.ListBox1.ControlTipText = "Déplacement <- possible par glisser-déplacer !"
    End If
  End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Nom As String
    Nom = InputBox("entrer le nouveau nom de la variable" & Chr(13) & Chr(13) & "Libellé actuel : " & ListBox1.Value, "Changement de l'intitulé", ListBox1.Value)
    If Nom <> "" Then
        ListBox1.List(ListBox1.ListIndex) = Nom
    End If
End Sub

Et encore un grand merci a jmfmarques
jmf : pour ce qui du déroulement de la liste, j'essaye de regarder aussi de mon coté (meme si c'est sans succès pour l'instant ) mais pas de souci je patiente
a bientôt

[jmfmarques]

Hello Bandit !
Ne te fatigues plus : c'est fait, et sans APIs comme promis !
quand tu es prêt, tu dis ...
Avant de "réapparaître", tu vas faire quelques modifications :

1) tout en haut de ton code :

Code :

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

1
2
3
4
Private jmfcoucou As String
Private hauteur As Integer
Private critx1 As Integer, critx2 As Integer, crithy1 As Integer, crithy2 As Integer
Private critby1 As Integer, critby2 As Integer

2) nous allons définir hauteur dans Userform_activate, immédiatement après copie.zorder
A ce propos : je crois avoir compris que VBA était en points et pas twips.
Il est dans ce cas préférable de ne pas "geler" sur la taille que tu as choisie pour ta police et de rendre hauteur plus souple :
au lieu, donc, de hauteur = 9, je te suggère hauteur = list1.fontsize
corriges...
dans ton mouse_move enlèves donc :
Dim hauteur As Integer (que nous définissons ailleurs)
Font = List2.Font (que tu as oublié de supprimer !)
hauteur = 9 (qui n'a plus à être là, maintenant)
3) transformes ainsi l'événement activate de ton userform (complété en vue de ce que je t'enverrai dquand tu seras prêt :

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Form_Activate()
 copie.ZOrder
 hauteur = list1.FontSize
 critx1 = List2.Left - List1.Left
 critx2 = critx1 + List2.Width
 crithy1 = List2.Top - List1.Top
 crithy2 = crithy1 + hauteur
 critby1 = crthy1 + List2.Height - hauteur
 critby2 = crithy1 + List2.Height
End Sub

Quand tu seras prêt, il ne manquera plus qu'à insérer une toute petite sous-routine de rien du tout

[bandit boy]

c'est bon le programme est fin pret pour recevoir les nouvelles instructions!

[jmfmarques]

Bonjour Bandit !

Sous-routine à insérer, donc :

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
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If List2.ListCount * hauteur <= List2.Height Then Exit Sub
  Dim dedansh As Boolean
  Dim dedansb As Boolean
  dedans = False
  If X >= critx1 And X <= critx2 Then
    dedansh = True
    dedansb = True
  Else
    dedansh = False
    dedansb = False
  End If
  If Y >= crithy1 And Y <= crithy2 And dedansh Then dedansh = True Else dedansh = False
  If Y >= critby1 And Y <= critby2 And dedansb Then dedansb = True Else dedansb = False
  If Not dedansh And Not dedansb Then Exit Sub
  If dedansh And List2.TopIndex = 0 Then Exit Sub
  If dedansb And (List2.ListCount - List2.TopIndex) * hauteur <= List2.Height Then Exit Sub
  If dedansb Then List2.TopIndex = List2.TopIndex + 1
  If dedansh Then List2.TopIndex = List2.TopIndex - 1
  DoEvents
End Sub

Précision, le déroulement se fait en passant la souris (bouton toujours enfoncé) non sur l'ascenseur du Scroll mais dans la listbox elle-même .
Si le déroulement est possible, il se déclenche lorsque la souris passe sur le 1er article affiché (déroulement vers le haut) ou sur le dernier article affiché (pour dérouler alors vers le bas).
Aucun déroulement, bien sur si :
- le nombre d'articles de dépasse pas la capacité de la listbox
- l'article affiché en haut est déjà le 1er
- l'article affiché en bas est déjà le dernier

Essayes et dis-moi si VBA doit me conduire à un ajustement éventuel ...
ATTENTION : Il s'agit bien de l'événement MouseMove de List1 (surtout pas celui qui te paraitrait logique , de list2 !!!)

Je serais de retour dans 2 heures 30

[bandit boy]

Bin c'est super ca fonctionne très bien!!
Maintenant je vais m'atteler a la tache pour en comprendre le fonctionnenement, car cela m'intrigue ^^ et j'avoue que pour l'instant je n'ai pas tout compris!