Case à cocher à colorer le fond

Bonjour,

J'ai une demande à faire, mais je ne sais pas si cela est possible.

Je viens de commencer des cours de généalogie, et j'ai créé une fiche à remplir par personne ou il y a des cases à cocher, et j'aimerai que lorsque je coche une ou plusieurs case(s), le fond de celle-ci se colore. je vous joint le modèle.

Déjà un grand merci pour votre aide si cela est possible.

Bonjour,

Je vous l'ai fait pour les cases "civilités" (sexe), saurez-vous le faire pour les autres?

Dim ShpGroup As Shape
Dim ShpCheckBox1 As Shape, ShpCheckBox2 As Shape, ShpCheckBox3 As Shape

Sub CaseACocher_1() 'sexe M
    Set ShpGroup = ActiveSheet.Shapes("Groupe 1")
    Set ShpCheckBox1 = ShpGroup.GroupItems("Check Box 1") 'sexe M
    Set ShpCheckBox2 = ShpGroup.GroupItems("Check Box 2") 'sexe ?
    Set ShpCheckBox3 = ShpGroup.GroupItems("Check Box 3") 'sexe F
    If ShpCheckBox1.OLEFormat.Object.Value = 1 Then ' 1 =case cochée
        ShpCheckBox1.OLEFormat.Object.Interior.Color = RGB(0, 255, 0) ' Vert
        ShpCheckBox2.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox3.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox2.OLEFormat.Object.Value = 0 ' décocher
        ShpCheckBox3.OLEFormat.Object.Value = 0 ' décocher
    Else
        ShpCheckBox1.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
    End If
End Sub

Sub CaseACocher_3() 'sexe F
    Set ShpGroup = ActiveSheet.Shapes("Groupe 1")
    Set ShpCheckBox1 = ShpGroup.GroupItems("Check Box 1") 'sexe M
    Set ShpCheckBox2 = ShpGroup.GroupItems("Check Box 2") 'sexe ?
    Set ShpCheckBox3 = ShpGroup.GroupItems("Check Box 3") 'sexe F
    If ShpCheckBox3.OLEFormat.Object.Value = 1 Then ' 1 =case cochée
        ShpCheckBox3.OLEFormat.Object.Interior.Color = RGB(0, 255, 0) ' Vert
        ShpCheckBox1.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox2.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox1.OLEFormat.Object.Value = 0 ' décocher
        ShpCheckBox2.OLEFormat.Object.Value = 0 ' décocher
    Else
        ShpCheckBox3.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
    End If
End Sub

Sub CaseACocher_2() 'sexe ?
    Set ShpGroup = ActiveSheet.Shapes("Groupe 1")
    Set ShpCheckBox1 = ShpGroup.GroupItems("Check Box 1") 'sexe M
    Set ShpCheckBox2 = ShpGroup.GroupItems("Check Box 2") 'sexe ?
    Set ShpCheckBox3 = ShpGroup.GroupItems("Check Box 3") 'sexe F
    If ShpCheckBox2.OLEFormat.Object.Value = 1 Then ' 1 =case cochée
        ShpCheckBox2.OLEFormat.Object.Interior.Color = RGB(0, 255, 0) ' Vert
        ShpCheckBox1.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox3.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
        ShpCheckBox1.OLEFormat.Object.Value = 0 ' décocher
        ShpCheckBox3.OLEFormat.Object.Value = 0 ' décocher
    Else
        ShpCheckBox2.OLEFormat.Object.Interior.Color = RGB(174, 170, 170) ' gris
    End If
End Sub

le fichier

Cdlt

Bonjour Arturo83,

Merci pour votre réponse, c'est très bien, mais je ne connais rien en VBA, je vais essayer de faire les modifications pour les autres cases, mais pourriez-vous me donner la marche à suivre?

Encore merci,

Alors voici une version plus complète:

Un tout grand merci pour votre travail, c'est impeccable :)

Juste une petite dernière chose, le veuvage union 2 ne se colore pas?, Mais si c'est compliqué c'est bon ainsi.

Encore merci, c'est exactement cela que je pensais sans savoir le faire.

C'est un oubli de ma part, pour que vous compreniez bien comment il faut affecter la case à cocher à la macro, je ne vais pas vous le faire , simplement vous le montrer comme ça vos pourrez le reproduire si nécessaire.

Prinicpe: un premier clic droit sur la case à cocher sélectionne tout le groupe, un deuxième clic droit sélectionne la case à cocher, il n'y a plus qu'à lui affecter la macro 'Groupe_en_vert", comme sur la vidéo:

Merci Arturo83,

C'est génial, et en plus la petite vidéo extra.

Tout fonctionne parfaitement.

Encore merci,

Papout,