Bonjour,
Une autre piste avec des Shapes. Ce sont les cases à cocher de gauche qui sont prises en compte (je ne sais pas si celles de droite doivent aussi être prises en compte). Pour les couleurs, je te laisse t'amuser avec RGB()
Le classeur :
Le code :
Sub Cocher()
Dim S As Shape
Dim Total As Integer
For Each S In ActiveSheet.Shapes
If Left(S.Name, 5) = "Coche" Then
If S.ControlFormat.Value = 1 Then Total = Total + 1
End If
Next S
Progression Total, 8
End Sub
Sub Progression(ByVal Valeur As Double, _
ByVal Maxi As Double)
Dim Fond As Shape
Dim Progress As Shape
Dim R As Double
Set Fond = ActiveSheet.Shapes("RectFond")
Set Progress = ActiveSheet.Shapes("RectProgress")
R = Fond.Width / Maxi
Progress.Width = Valeur * R
Select Case Valeur
Case Is < 4
Progress.Fill.ForeColor.RGB = RGB(255, 0, 0)
Case Is < 7
Progress.Fill.ForeColor.RGB = RGB(0, 0, 255)
Case Else
Progress.Fill.ForeColor.RGB = RGB(0, 255, 0)
End Select
Range("D8").Value = Format(Valeur / Maxi, "0#.00%")
End Sub