[Résolu] Macro case à cocher

[D277]

Bonjour à tous,

Voilà mon problème : j'ai pour tâche d'améliorer le suivi des consommables pour le boulot.
J'ai joint un fichier qui montre la forme de ce suivi avec ces fameuses cases à cocher.
Ce que je souhaite, c'est lorsque l'on coche la case (qui correspond à une commande reçue), la ligne soit grisée et lorsqu'on la décoche pour quelque raison que ce soit, elle redevienne sans format donc blanche.
N'étant pas un expert en VBA, j'ai essayé de faire ce dont j'étais capable mais là je tourne en rond. Cette macro se trouve dans le module1 et concerne la première case de la feuil1.

En feuil2, j'ai mis l'alternative que j'utilise en ce moment (forme conditionnelle plus cellule liée des cases). Mais lier chaque cellule à sa propre case est assez fastidieux et je n'ai pas trouvé le moyen de faire mieux.

Je vous remercie d'avance pour l'aide que vous pourriez me fournir.

Bonne journée

D277

 

[Compte Supprimé 979]

Re : Macro case à cocher

Bonjour,

Plutôt que d'utiliser des case à cocher, utilise la police Windings

Voici ton fichier avec du code dans Feuil1

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Cancel = True
    If Target.Value = "¨" Then
      Target.Value = "þ"
      With Range(Target.Offset(0, 1), Target.Offset(0, 4))
        .Interior.ColorIndex = 15
      End With
    Else
      Target.Value = "¨"
      With Range(Target.Offset(0, 1), Target.Offset(0, 4))
        .Interior.ColorIndex = xlNone
      End With
    End If
  End If
End Sub

En plus cela peux te permettre des faire des filtres par la suite

A+

 

[D277]

Re : Macro case à cocher

Bonjour BrunoM45,

Tout d'abord, merci de m'avoir consacré du temps et un grand merci pour ta solution.
Je ne connaissais pas cette possibilité avec la police Wingdings.

Une dernière chose, peux-tu m'indiquer à quoi sert ces lignes de code contenues dans le workbook :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 2 Or Target.Row = 1 Then Exit Sub
Cancel = True
If Target = "" Then Target = "X" Else Target = ""
Cells(Target.Row, 1).Resize(, 6).Interior.ColorIndex = IIf(Target = "", xlNone, 35)
End Sub


A moins que cette macro complète celle en feuil1 ?

Bonne journée

D277