Sub toto(plage As Range, cellule As Range)
Dim i, cel, w, c()
Set w = plage.Cells(1, 1).FormatConditions
ReDim c(1 To w.Count, 2)
For i = 1 To w.Count
c(i, 0) = w(i).Interior.Color
c(i, 1) = 0
c(i, 2) = w(i).Font.Color
Next
With plage
For Each cel In .Cells
For i = 1 To w.Count
If cel.DisplayFormat.Interior.Color = c(i, 0) Then c(i, 1) = c(i, 1) + 1
Next
Next
End With
With cellule
.Resize(1, 2) = Array("couleur", "nombre")
For i = 1 To w.Count
.Offset(i).Interior.Color = c(i, 0)
.Offset(i).Font.Color = c(i, 2)
Next
.Offset(1).Resize(w.Count, 2).Value = c
End With
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Cible As Range, Contremander As Boolean)
If Not Intersect(Cible, Range("B3:E6")) Is Nothing Then toto Range("B3:E6").Cells, Range("C9").Cells: Contremander = True
End Sub