Changer un état selon l'état d'une case à cocher

6fichier.xlsm (18.62 Ko)

Salut,

J'ai ce fichier qui contient des macros qui fonctionnent bien pour se rafraîchir chaque 4s et detecter les mail a partir de mon Outlook via Excel

Sauf que je veux ajouter une Case à Cocher devant chaque ligne dont l'état est affiché en jaune et si elle la case est cochée l'état devient en vert

Sinon si décochée l'état revient en jaune

Mon erreur: j'arrive pas a changer la couleur selon la Case à cocher

et dans le troisieme marco comment je peux eviter la .Select et With Selection et la remplacer avec un autre terme qui ajoute la case sans la lasiser selectionnée svp?

Sub Auto_Get()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim Cbox As CheckBox
Dim Shp As Shape

ActiveWorkbook.RefreshAll
Application.OnTime Now + TimeValue("00:00:04"), "Auto_Get"

Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")

Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Test")

i = 1

For Each OutlookMail In Folder.Items

    'Set Cbox = ActiveSheet.CheckBoxes.Add(Left:=Range("C2").Left, Top:=Range("C2").Top, Width:=Range("C2").Width, Height:=Range("C2").Height)

If OutlookMail.UnRead = True Then

        'Rouge si non lu (fonctionnelle)
        Range("Subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("State").Offset(i, 0).Value = 0

        'Jaune si lu et ajoute une checkbox (fonctionnelle mais sans checkbox)
        ElseIf OutlookMail.UnRead = False Then
        Range("Subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("State").Offset(i, 0).Value = 1

        'Ajouter une CheckBox ici

        'With Cbox
        '.Name = Cbox
        '.Caption = ""
        '.Value = xlOff
        '.LinkedCell = Range("C2").Offset(i, 0)
        '.Display3DShading = False

        'Vert si checkbox cochée (ni fonctionnelle ni avec checkbox)
        ElseIf OutlookMail.UnRead = False & Cbox.Value = True Then
        Range("Subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("State").Offset(i, 0).Value = 2

        'Jaune de nouveau si checkbox enlevé (ni fonctionnelle ni avec checkbox)
        ElseIf OutlookMail.UnRead = False & Cbox.Value = False Then
        Range("Subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("State").Offset(i, 0).Value = 1

        End If

        i = i + 1

Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub
Sub iconsets()
Range("B1").Name = "State"
Dim iset As IconSetCondition
Set rg = Range("B1", Range("B2").End(xlDown))
rg.FormatConditions.Delete
Set iset = rg.FormatConditions.AddIconSetCondition
'Select the iconset
With iset
    .IconSet = ActiveWorkbook.iconsets(xl4TrafficLights)
    .ReverseOrder = False
    .ShowIconOnly = True
End With
'ROUGE SI STATE = 0
With iset.IconCriteria(1)
    .Type = xlConditionValueFormula
    .Operator = xlGreaterEqual
    .Value = 0
End With
'JAUNE SI STATE = 1
With iset.IconCriteria(2)
    .Type = xlConditionValueFormula
    .Operator = xlGreaterEqual
    .Value = 1
End With
'VERT SI STATE = 2
With iset.IconCriteria(3)
    .Type = xlConditionValueFormula
    .Operator = xlGreaterEqual
    .Value = 2
End With
End Sub
Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "C").Left
        MyTop = Cells(cell, "C").Top
        MyHeight = Cells(cell, "C").Height
        MyWidth = Cells(cell, "C").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff

            .Display3DShading = False
        End With

    End If
Next cell

Application.ScreenUpdating = True

End Sub
Rechercher des sujets similaires à "changer etat case cocher"