Microsoft 365 Affichage case à cocher en fonction de la couleur d'une autre cellule

Coralie01120

XLDnaute Occasionnel
Bonjour,
Je bloque sur un sujet Excel.
Dans l'onglet VREF, j'aimerai que lorsque les cellules de la colonnes D deviennent bleues (colonne D > colonne C) il y ait une case à cocher qui apparaisse dans la colonne E. Est ce possible avec une macro ?

Je vous remercie !
 

Pièces jointes

  • Indicateurs.xlsm
    868.2 KB · Affichages: 14
Solution
Bonjour Coralie01120

Voici une possibilité à adapter à ton besoin.

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Obj As OLEObject
    If Not Application.Intersect(Target, Range("D:D")) Is Nothing Then 'verifie la colonne modifiée est en D
        If Target > Target.Offset(0, -1) Then 'vérifie si colonne D supérieur à la colonne C
            For Each Obj In ActiveSheet.OLEObjects
                If TypeName(Obj.Object) = "CheckBox" And Obj.Name = "CKB" & Target.Address Then ' vérifie si la ChecbBox existe déjà pour cette valeur
                    Exit Sub 'si oui sort de la Sub
                End If
            Next Obj
            Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _...

Papyty

XLDnaute Nouveau
Bonjour Coralie01120

Voici une possibilité à adapter à ton besoin.

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Obj As OLEObject
    If Not Application.Intersect(Target, Range("D:D")) Is Nothing Then 'verifie la colonne modifiée est en D
        If Target > Target.Offset(0, -1) Then 'vérifie si colonne D supérieur à la colonne C
            For Each Obj In ActiveSheet.OLEObjects
                If TypeName(Obj.Object) = "CheckBox" And Obj.Name = "CKB" & Target.Address Then ' vérifie si la ChecbBox existe déjà pour cette valeur
                    Exit Sub 'si oui sort de la Sub
                End If
            Next Obj
            Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=Target.Offset(0, 1).Left + 2, Top:=Target.Offset(0, 1).Top + 2.5, _
                Width:=105, Height:=11.5) 'Si non créé la CheckBox
            With Obj
                .Name = "CKB" & Target.Address 'Nom de la CheckBox
                .Object.Caption = "Traité" 'Texte de la CheckBox
                .Object.Font.Size = 7 'Taille de la police de la CheckBox
            End With
        Else
            For Each Obj In ActiveSheet.OLEObjects 'Si colonne D n'est pas supérieur à la colonne C
                If TypeName(Obj.Object) = "CheckBox" And Obj.Name = "CKB" & Target.Address Then 'vérifie si ChkBox existe et la supprime
                    Obj.Delete
                    Exit Sub
                End If
            Next Obj
        End If
    End If
End Sub

A positionner dans le code de la feuille, voir fichier en piece jointe.

Bonne journée
 

Pièces jointes

  • Copie de Indicateurs.xlsm
    867.9 KB · Affichages: 11

Discussions similaires

Réponses
9
Affichages
153

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16