cocher et décocher une case

Christian3000

XLDnaute Nouveau
Bonjour à tous,

Je fais face à un problème dont la solution doit certainement être toute simple.
J'ai créé un calendrier dont les cases se colorent automatiquement (en jaune ou en vert selon les cas) si elles correspondent à des dates de tâches à effectuer, rentrées sur des colonnes tierces. Tout est géré par VBA. J'ai ensuite inséré une case à cocher qui, lorsqu'elle est cochée, signifie que la tâche a été effectuée. Dans ce cas, les cases du calendriers s'affichent en rouge.
Jusque là tout va bien.
Le problème survient lorsque je décoche la case à cocher: dans ce cas là, j'aimerais que le changement de couleur (de jaune ou vert à rouge) s'annule. Le problème c'est que je ne sais pas comment faire pour annuler les effets de la case à cocher!

Voici le code pour un peu plus de clarté:

Private Sub CheckBox1_Click()

Dim dates As Range, planning As Range, debut As Range, fin As Range, today As Range

Set dates = Sheets("planning RH").Range("dates")
Set planning = Sheets("planning RH").Range("planning")
Set debut = Sheets("planning RH").Range("debut")
Set fin = Sheets("planning RH").Range("fin")

For x = 1 To 40
For y = 1 To 180

With CheckBox1

If CheckBox1.Value = True _
And (dates.Cells(1, y).Value >= debut.Cells(1, 1)) _
And (dates.Cells(1, y).Value <= fin.Cells(1, 1)) Then
planning.Cells(1, y).Interior.ColorIndex = 3
End If

If CheckBox1.Value = False _
And (dates.Cells(1, y).Value >= debut.Cells(1, 1)) _
And (dates.Cells(1, y).Value <= fin.Cells(1, 1)) Then
:confused::confused::confused:

End If

End With

Next y
Next x

End sub

Grand merci pour votre aide toujours précieuse!

Salutations,

Christian
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : cocher et décocher une case

Bonjour Christian, bonjour le forum,

Sans aveoi teste peut-être comme ça :
Code:
planning.Cells(1, y).Interior.ColorIndex = xlNone

Juste une remarque, en l'état le With CheckBox1...End With ne sert à rien...
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : cocher et décocher une case

Bonjour Christian, bonjour le forum,

Oui je comprend mieux le problème (je me disais aussi qu'une réponse aussi c... n'allait pas satisfaire, lol). Mais du coup c'est beaucoup plus complexe car il faudrait stocker ces couleurs ailleurs avant de faire le changement. Donc eventuellement avoir un copie cachée du planning et aller récupérer les couleurs dans cette copie si on désélectionne la case à cocher par la suite... Je ne vois que ça pour l'instant.
 

Christian3000

XLDnaute Nouveau
Re : cocher et décocher une case

Ok, c'est plus compliqué que je pensais: je me disais qu'on pouvait peut-être rappeler la sub qui avait permis de colorer initialement les cases, du genre:

If CheckBox1.Value = False _
And (dates.Cells(1, y).Value >= debut.Cells(1, 1)) _
And (dates.Cells(1, y).Value <= fin.Cells(1, 1)) Then
sub(color).activate

Est-ce une voie sans issue?

Merci pour ton aide en tout cas.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : cocher et décocher une case

Bonjour Christian, bonjour le forum,

Oui ce que tu proposes me semble être une bonne idée, remettre les couleurs en utilisant la macro qui avait coloré les cellules au départ.
Mais comme je n'ai pas toutes les données il m'est difficile de t'aider d'avantage. Un fichier exemple serait le bien venu pour mieux cerner le problème. Si il est trop lourd tu l'épure un maximum et ne laisse que quelques données liées au problème...
 

Christian3000

XLDnaute Nouveau
Re : cocher et décocher une case

Voilà le fichier. A noter que la checkbox en question est présente sur la première ligne uniquement (en attendant d'en mettre partout...)
Merci encore pour ton aide!
Christian
 

Pièces jointes

  • exemple.zip
    18.9 KB · Affichages: 74
  • exemple.zip
    18.9 KB · Affichages: 78
  • exemple.zip
    18.9 KB · Affichages: 86

Robert

XLDnaute Barbatruc
Repose en paix
Re : cocher et décocher une case

Bonjour Christian, bonjour le forum,

Ça à l'air de marcher comme ça :
Code:
Private Sub CheckBox1_Click()
Dim dates As Range, planning As Range, debut As Range, fin As Range, today As Range
 
Set dates = Sheets("planning RH").Range("dates")
Set planning = Sheets("planning RH").Range("planning")
Set debut = Sheets("planning RH").Range("debut")
Set fin = Sheets("planning RH").Range("fin")
Set today = Sheets("planning RH").Range("today")
 
For x = 1 To 40
    For y = 1 To 180
 
        If CheckBox1.Value = True _
            And (dates.Cells(1, y).Value >= debut.Cells(1, 1)) _
            And (dates.Cells(1, y).Value <= fin.Cells(1, 1)) Then
                planning.Cells(1, y).Interior.ColorIndex = 3
        End If
 
        If CheckBox1.Value = False _
            And (dates.Cells(1, y).Value >= debut.Cells(1, 1)) _
            And (dates.Cells(1, y).Value <= fin.Cells(1, 1)) Then
                If (dates.Cells(1, y).Value >= debut.Cells(x, 1)) _
                    And (dates.Cells(1, y).Value <= fin.Cells(x, 1)) _
                    And (dates.Cells(1, y).Value <= fin.Cells(x, 1)) Then
                        planning.Cells(x, y).Interior.ColorIndex = 6
                End If
 
                'les tâches du jour en orange
                If (dates.Cells(1, y).Value = today.Cells(x, 1)) _
                    And (dates.Cells(1, y).Value >= debut.Cells(x, 1)) _
                    And (dates.Cells(1, y).Value <= fin.Cells(x, 1)) Then
                        planning.Cells(x, y).Interior.ColorIndex = 45
                End If
 
                'les week-ends en gris
                If Weekday((dates.Cells(1, y)), vbMonday) > 5 Then
                    planning.Cells(x, y).Interior.ColorIndex = 15
                End If
        End If
 
    Next y
Next x
End Sub
 

Statistiques des forums

Discussions
312 505
Messages
2 089 096
Membres
104 030
dernier inscrit
Angy