Changer un état selon l'état d'une case à cocher
B
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 SubSub 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 SubSub 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