Discussion :

[deedolith]

Bonjour,

J'ai une listbox avec laquelle je fait du drag & drop.

Si l'utilisateur a sélectionné plusieurs items (contigus ou non),
qu'il a cliqué ailleur,
qu'il revient sur cette dernière pour commencer une opération de drag & drop en cliquant sur l'un des item précédemment sélectionné,
la sélection des items est mise à jour (il ne reste qu'un seul item sélectionné).

Je souhaite pouvoir conserver les items précédement sélectionnés si l'utilisateur clique sur l'un d'entre eux.

[deedolith]

Je pense avoir trouvé quelque chose:

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
Option Explicit
 
Private mSelectedItems As Scripting.Dictionary
 
Private Sub UserForm_Initialize()
    Set mSelectedItems = CreateObject("Scripting.Dictionary")
End Sub
 
Private Sub ListBox1_Change()
    Static Processing As Boolean
 
    If Not (Processing) Then
        Processing = True
        If (mSelectedItems(ListBox1.ListIndex) = True) Then
            RestoreSelectedItems
            ListBox1.Selected(ListBox1.ListIndex) = True
            SaveSelectedItems
        Else
            SaveSelectedItems
        End If
        Processing = False
    End If
End Sub
 
Private Sub SaveSelectedItems()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        mSelectedItems(i) = ListBox1.Selected(i)
    Next
End Sub
 
Private Sub RestoreSelectedItems()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = mSelectedItems(i)
    Next
End Sub

[patmeziere]

Bonjour deedolith

Je vous propose une autre solution

1. Elle est moins lourde pas d'objet externe(comme le dictionnaire)
2. Pas de re bouclage sur la liste complète
3. Pas de sub tout se passe dans l'event "Change" de la listbox

Exemple:

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
Option Explicit
 
'La variable TbL sera ma variable  array dimensionnée  au nombres de lignes de la listbox contenant des booleens
Dim TbL
 
Private Sub UserForm_Initialize()
 
'pour l'exemple je rempli une ListBox avec des chiffres de 1 à 10( ce peut etre tout type de donnée)
    ListBox1.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
 
    'si tbl n'est pas un array on le dimensionne
    If Not IsArray(TbL) Then ReDim TbL(0 To ListBox1.ListCount - 1) As Boolean
 
End Sub
 
Private Sub ListBox1_Change()
    With ListBox1
        'Pour le cas ou un item serai ajouté  on gere cela aussi en redimensionnant l'array TbL avec préservation
        If UBound(TbL) < .ListCount Then ReDim preservetbl(0 To .ListCount - 1)
 
        'Le change est aussi déclenché au remplisage  ou a l'ajout d'un item
        'Alors on bloque l'events  si l'index est -1(aucune selection )
        If .ListIndex = -1 Then Exit Sub
 
        'Si l'array tbl( index de la listbox) est true mais que l'index de la listbox est false( donc différent)
        If TbL(.ListIndex) = True And TbL(.ListIndex) <> .Selected(.ListIndex) Then
 
            .Selected(.ListIndex) = True    'L'item est remit à true
 
        Else
 
            TbL(.ListIndex) = True    'Sinon on le met à true tout simplement
 
        End If
 
    End With
 
    'J'ai exactement le même résultat
    'Sauf que je n'utilise aucun object externe comme le dictionnaire de Scripting.Dictionnary
    'Une différence  aussi( et pas des moindres) c'est que a aucun moment je re boucle sur l'array ou la liste
    'Et pour finir tout se passe dans l'event change
End Sub

Bonne journée

[deedolith]

Presque,

La sélection est mise à jour lorsque l'on commence à faire du drag & drop, et que la souris se déplace verticalement (sur l'axe Y).

Merci pour l'effort tous de même.

[patmeziere]

re
pour info même réaction avec le dictionnaire

[deedolith]

Permet moi de réfuter.

Ce n'est pas ce que j'observe.

[patmeziere]

re
c'est très étonnant vous avez sans doute omis du code dans votre proposition de solution

[deedolith]

Mea culpa,
en effet, voila le contexte que tu n'as pas: L'évènement MouseMove:

Code :

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

1
2
3
4
5
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If (Button = xlPrimaryButton) Then
        RestoreSelectedItems
    End If
End Sub

[patmeziere]

re
il n'y a pas de soucis
dans ce cas là pour ma version ce sera 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
Option Explicit
 
'La variable TbL sera ma variable  array dimensionnée  au nombres de lignes de la listbox contenant des booleens
Dim TbL
Dim ok As Boolean
Private Sub UserForm_Initialize()
 
'pour l'exemple je rempli une ListBox avec des chiffres de 1 à 10( ce peut etre tout type de donnée)
    ListBox1.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
 
    'si tbl n'est pas un array on le dimensionne
    If Not IsArray(TbL) Then ReDim TbL(0 To ListBox1.ListCount - 1) As Boolean
 
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If (Button = xlPrimaryButton) Then ok = False Else: ok = True
End Sub
Private Sub ListBox1_Change()
    With ListBox1
        'Pour le cas ou un item serai ajouté  on gere cela aussi en redimensionnant l'array TbL avec préservation
        If UBound(TbL) < .ListCount Then ReDim preservetbl(0 To .ListCount - 1)
 
        'Le change est aussi déclenché au remplisage  ou a l'ajout d'un item
        'Alors on bloque l'events  si l'index est -1(aucune selection )
        If .ListIndex = -1 Then Exit Sub
        If ok Then
            'Si l'array tbl( index de la listbox) est true mais que l'index de la listbox est false( donc différent)
            If TbL(.ListIndex) = True And TbL(.ListIndex) <> .Selected(.ListIndex) Then
 
                .Selected(.ListIndex) = True    'L'item est remit à true
 
            Else
 
                TbL(.ListIndex) = True    'Sinon on le met à true tout simplement
 
            End If
        End If
 
    End With
 
    'J'ai exactement le même résultat
    'Sauf que je n'utilise aucun object externe comme le dictionnaire de Scripting.Dictionnary
    'Une différence  aussi( et pas des moindres) c'est que a aucun moment je re boucle sur l'array ou la liste
    'Et pour finir tout se passe dans l'event change
End Sub

et j'ai le même résultat

Le principe:
une variable booleenne "Ok" global module elle pourrait être static dans les fonctions aussi si on veut
si mouse_move avec bouton 1 ok est false sinon ok est true

autrement dit le mosemove boutton 0 fait office de mouseup

donc si ok=false l'index sur le quel je suis entrain de me promener reprend la valeur de l'item de TbL (même index)

là encore une fois pas besoins de boucler

et dans le change si ok c'est sélectionné sinon on passe

------------------------------
Sauf que dans celui avec le dictionnaire il se trompe

J'ai l'impression qu'il prend quand même le dernier item survolé dans un sens ou dans l'autre

nouvelle démonstration
Regardez bien a gauche le problème avec votre méthode avec le survol entre le 5 et le 7

ci joint les deux exemples

[deedolith]

Hmmm,

Le but est de figer la sélection si on commence un drag & drop (la sélection qui change lorsque les items sont en cours de déplacement, c'est pas terrible).

Par contre, je me rend compte d'une faiblesse, ma solution courante accumule les sélections (pas moyen de désélectionner un ou plusieurs items).
Nouveau casse-tête en perspective.

[patmeziere]

re
et oui après ça devient compliqué
mais faut régler le problème avec la méthode dico avant tout si vous tenez a garder cette méthode
et aussi peut être passer par un autre events que le change

perso quand je m'amuse a ce jeu de (détourner les events) en général j'utilise l'events mouse up

1. l'action est validée
2. le listindex réel est dispo
3. peut être même réduire a trois fois rien le code

à méditer

[patmeziere]

re
et oui comme je disais le mouse up est une alternative intéressante
j'obtiens le même résultat avec ceci
sauf que en plus j'ai éventuellement le clic droite pour supprimer le dernier index sélectionné

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
Option Explicit
Dim TbL
 
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With ListBox1
        Select Case Button
        Case 1
            If TbL(.ListIndex) = False Then TbL(.ListIndex) = True Else .Selected(.ListIndex) = True
        Case 2
            TbL(.ListIndex) = False: .Selected(.ListIndex) = False
        End Select
    End With
End Sub
 
Private Sub UserForm_Initialize()
    ListBox1.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    ReDim TbL(0 To ListBox1.ListCount - 1) As Boolean
End Sub

[deedolith]

Bon, quelque soit la méthode, je n'arrive pas à obtenir les comportements désirés.
La tambouille interne de Windows est la plus forte.

[deedolith]

Je remonte ce sujet car je n'ai toujours pas trouvé de solution satisfaisante.

L'idée est de se rapprocher du comportement de la liste des fichiers dans l'explorateur de fichiers.

[patmeziere]

Bonjour deedolith
je crois comprendre maintenant ,que tu parles du highlighting des items sans relever le bouton une fois appuyé
est-ce bien ça ?

[deedolith]

Oui, c'est cela.

[patmeziere]

re
alors là mon ami ça va devenir coton
je regarderais ce soir si je peux faire quelque chose
j'ai 2/3 idées

[patmeziere]

Bonjour deedolith

hier j'ai bien réussi a faire le truc mais ça scintille sursaute bref c'est pas joli
je crois que la la mécanique Win a gagné

[deedolith]

Je me demande s'il n'y a pas moyen d'exploiter l'interface COM IAccessible,
elle fournit entre autre un methode accHitTest.

[patmeziere]

re
ben comme la listbox a un handle ça devrait être possible
si je me souvient bien c'est
msgbox listbox.[Get_hwnd]
parti de la avec api ou iaccessible voir Uiautmationclient