Listbox (selection multiple), conserver la sélection
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.
Une autre solution moins lourde en tout points
Bonjour deedolith
Je vous propose une autre solution
- Elle est moins lourde pas d'objet externe(comme le dictionnaire)
- Pas de re bouclage sur la liste complète
- Pas de sub tout se passe dans l'event "Change" de la listbox
Exemple:
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
| 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
re:Une autre solution moins lourde en tout points
re
pour info même réaction avec le dictionnaire
2 pièce(s) jointe(s)
re:Une autre solution moins lourde en tout points
re
c'est très étonnant vous avez sans doute omis du code dans votre proposition de solution
Pièce jointe 653643
2 pièce(s) jointe(s)
re:Une autre solution moins lourde en tout points
re
il n'y a pas de soucis
dans ce cas là pour ma version ce sera 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
| 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
Pièce jointe 653660
ci joint les deux exemples
re:Une autre solution moins lourde en tout points
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
- l'action est validée
- le listindex réel est dispo
- peut être même réduire a trois fois rien le code
à méditer
re:Une autre solution moins lourde en tout points
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:
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 |
