XL 2019 Choix multiple case à cocher

[Fanrs]

Bonjour à tous,

Je bloque depuis un petit moment sur la résolution de mon problème, je craque et demande de l'aide... C'est plus un problème de gout que de fonctionnalité

En gros l'utilisateur faire une sélection multiple et les résultats de cette sélection sont reportés en E12

Il faudrait que :
-la zone de liste à sélection multiple ne soit pas une liste déroutante
-qu'elle puisse s'adapter à ma "listfillrange" (C1:C20) qui peut est de longueur variable (sans m'afficher les cases vides sans intitulé)
-que la valeur par défaut soit toute cochée avec report en E12 des résultats sélectionnés
-si possible pas de validation pour le report en E12

Place aux experts
Merci d'avance

Fichier exemple

 

[job75]

Ah mais c'est mieux de tout faire avec le double-clic en E12, fichier (4) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [E12]) Is Nothing Then Exit Sub
Dim test As Boolean, i&
Cancel = True
test = IsEmpty([E12])
With ListBox1
    For i = 0 To .ListCount - 1
        .Selected(i) = test
    Next
End With
End Sub

 

[Fanrs]

Merci

Pour tout sélectionner, cela m'embête un peu, car votre solution nécessite une action de l'utilisateur, j'aimerai plutôt que cela soit automatique par appel de macro dans un module... Possible ?

Événement sans "Private" et dans un module :

Sub appel()
Range("E12").Select
    Sheets("Feuil1").Worksheet_BeforeDoubleClick ActiveCell, True
End Sub

Fonctionnel mais vous en pensez quoi ?

 

[mapomme]

Bonjour @Fanrs , @job75 ,

Inutile de sélectionner avant l'appel avec :

Sub appel()
    Sheets("Feuil1").Worksheet_BeforeDoubleClick Sheets("Feuil1").Range("E12"), True
End Sub

 

[Fanrs]

Merci à tous

 

[mapomme]

Re,

En général, je fais le contraire

• on définit la procédure Appel() dans un module
• et on exécute Appel() dans la procédure évènementielle dont on garde le caractère Private

Dans module1:

Sub appel()
Dim test As Boolean, i&
   test = IsEmpty(Sheets("Feuil1").[e12])
   With Sheets("Feuil1").ListBox1
       For i = 0 To .ListCount - 1: .Selected(i) = test: Next
   End With
End Sub

Et pour la procédure évènementielle:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   If Not Intersect(Target, [e12]) Is Nothing Then Cancel = True: appel
End Sub

edit: bonjour @Usine à gaz

 

[job75]

Re, salut mapomme,

La macro du post #16 prendra beaucoup de temps si la liste Liste est grande car la macro ListBox1_Change s'exécute entièrement à chaque sélection.

Pour éviter cela j'utilise une variable flag mémorisée pour bloquer ListBox1_Change, fichier (5) :

Dim flag As Boolean 'mémorise la variable

Private Sub Worksheet_Change(ByVal Target As Range)
ListBox1.ListFillRange = "Liste"
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [E12]) Is Nothing Then Exit Sub
Dim test As Boolean, a, b, i&
Cancel = True
test = IsEmpty([E12])
If TypeName([Liste]) = "Range" Then
    a = [Liste].Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim b(1 To UBound(a))
    For i = 1 To UBound(a): b(i) = a(i, 1): Next 'transposition
End If
If test And IsArray(b) Then [E12] = Join(b) Else [E12] = ""
flag = True 'bloque ListBox1_Change
With ListBox1
    For i = 0 To .ListCount - 1
        .Selected(i) = test
    Next
End With
flag = False
End Sub

Private Sub ListBox1_Change()
If flag Then Exit Sub
Dim i&, a(), n&
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then ReDim Preserve a(n): a(n) = .List(i, 0): n = n + 1
    Next
End With
[E12] = Join(a)
End Sub

 

[job75]

J'ai testé avec une liste de "seulement" 1000 cellules (C1:C1000).

Durée d'exécution chez moi du double-clic en E12 :

- fichier (4) => 15 à 16 secondes

- fichier (5) => 0,03 seconde...