[VBA] - Lister les valeurs uniques et insérer une checkbox par ligne

Bonjour,

Pour résoudre mon problème, j'envisage de passer par deux étapes :

• Lister, dans une nouvelle feuille, les données uniques présentes dans une colonne, ça je sais le faire.
• Dans la feuille de résultat, où sont listées les données, ajouter une "CheckBox" (dont je pourrai ensuite me servir via un autre code VBA).

J'arrive normalement à ajouter une "CheckBox" via VBA, mais pas directement dans la feuille.

L'objectif est de lister les valeurs uniques dans une nouvelle feuille et ensuite de cocher les lignes que l'on voudra traiter par la suite.

Chaque ligne cochée, sera copiée dans une autre feuille pour générer un tableau.

Si vous avez une meilleure méthode, je suis également preneur !

Je joins un fichier pour que vous puissiez avoir une idée du résultat que je cherche à obtenir.

Merci de votre attention !

Bonne journée.

Bonjour,

un essai pour ajouter les checkbox (cases à cocher formulaire) en colonne A de la feuille Résultat:

Sub AddCheckbox()
Dim S As Object, i As Long
With Worksheets("Résultat") '
For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
    Set S = .CheckBoxes.Add(.Cells(i, 1).Left + 10, .Cells(i, 2).Top, 15, 15)
                    '.Add(PositionHorizontale, PositionVerticale, Largeur, Hauteur)
    'Renomme la Checkbox.
    S.Name = "CB" & i
    'Modifie le texte affiché
    S.Characters.Text = "" '.Cells(i, 2).Value
    'Définit la cellule liée à activer si besoin
    'S.LinkedCell = .Name & "!" & .Cells(i, 1).Address ' colonne A ligne i
Next
End With
End Sub

A+

Bonjour,

Merci pour votre réponse, ça m'a bien l'air de fonctionner.

Par contre j'ai deux questions :

- Lorsque des cases sont cochées, comment puis-je ensuite les désigner pour m'en servir dans le reste du code ? Comment trouver leur numéro par exemple ?

L'idée sera de faire une recherche, à partir de la cellule (B "x") (x = cases cochées) et de rechercher dans une (ou plusieurs) autre(s) base(s) de données les informations correspondantes.

- Comment puis-je ensuite les supprimer ? Elles doivent disparaître car la liste peut changer de taille.

A plus tard

Bonjour,

chaque case à cocher est nommée : CB suivi du N° de ligne sur laquelle elle se trouve.

un essai pour lancer une action pour les case cochées, suivi de la suppression de toutes les cases à cocher:

Sub ActionSuppression()
With Worksheets("Résultat")
'partie action
For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
    If .Shapes("CB" & i).DrawingObject.Value = 1 Then
        MsgBox .Cells(i, 2).Value
        '.../... ici le code à exécuter pour les cases cochées
    End If
Next

' partie suppression
For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
    .Shapes("CB" & i).Delete
Next
End With
End Sub

A+

Bonjour,

Le code pour la suppression marche très bien !

Par contre, l'exécution du code, pour l'ajout de cases à cocher, fonctionne sur des petites listes, mais dans le cas d'une plus grande liste (quelques milliers de lignes), Excel peine à terminer la tâche.

Est-ce qu'en passant par une collection ; dans un UserForm vous pensez que ça pourrait aller plus vite ?

Bonjour,

je te déconseille d'ajouter des dizaines de checkbox à une feuille, à plus forte raison plusieurs milliers.

Fais-toi une petite macro qui t'ajoute une coche dans une cellule sur un double-clic.

En plus avec les coches de Wingdings ça sera plus joli, et tu peux mettre en vert.

eric

Bonjour,

Oui, c'est une bonne idée !

Je sais pas vraiment comment m'y prendre par contre.

Là j'essayais de créer une liste dans un UserForm, mais j'aurais également opté pour générer autant de cases à cocher qu'il n'y a de ligne dans la liste.

Je vais chercher ce que je peux faire pour cette histoire de coche !

Quelque chose du genre : Si double clic sur cellule en B:B ; alors ajouter une "Coche" en colonne A:A.

Et si une coche est présente alors, exécuter le reste du code sur les lignes concernées.

Je m'y suis pris ainsi pour faire apparaître 1 (et colorer la cellule ne vert) lorsqu'on double clique

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim row%, col%, Cible As Variant

Set lf = Worksheets("Listing flore")

lrlf = lf.Cells(Rows.Count, 2).End(xlUp).row
lclf = lf.Cells(1, lf.Columns.Count).End(xlToLeft).Column

If Not Application.Intersect(Target, Range("B2:B" & lrlf)) Is Nothing Then
row = Target.row
col = Target.Column
Cells(row, col - 1) = c & "+"
Cells(row, col - 1).Interior.ColorIndex = 4 'Cells(row, col - 1)

Cancel = True
End If
End Sub

Je peux me baser là dessus pour exécuter le reste du code, et ça devient très clairement plus simple !

Bon par contre je ne sais pas faire apparaître une "Coche" !

Edit : Maj, c'est bon !

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim row%, col%, Cible As Variant

Set lf = Worksheets("Listing flore")

lrlf = lf.Cells(Rows.Count, 2).End(xlUp).row
lclf = lf.Cells(1, lf.Columns.Count).End(xlToLeft).Column

If Not Application.Intersect(Target, Range("B2:B" & lrlf)) Is Nothing Then
row = Target.row
col = Target.Column
Cells(row, col - 1).Font.ColorIndex = 2
Cells(row, col - 1) = 1

With Cells(row, col - 1).FormatConditions(1)
    .ReverseOrder = False
    .ShowIconOnly = False
    .IconSet = ActiveWorkbook.IconSets(xl3Symbols2)
End With

Cancel = True
End If
End Sub

Attention que les MFC peuvent devenir très gourmandes car elles sont volatiles (recalculées à chaque action).

Un exemple avec coches. Mettre la colonne A en Wingding et vert.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column > 2 Or Target.Row = 1 Then Exit Sub
    Cancel = True
    Cells(Target.Row, 1) = IIf(Cells(Target.Row, 1) = "ü", "", "ü")
End Sub

Super !

C'est encore plus beau en plus haha !

Merci beaucoup pour l'aide apportée sur cette discussion, j'ai pu vraiment avancer dans mon projet !

Bonne journée