Sub MFCNombreCellulesAverees()
Dim CollFCS As Collection
Dim FC As Variant
Dim R As Range
Dim C As Range
Dim Plage As Range
Dim RPrecedent As Range
Dim i&
Dim maFormule$
Dim A$
'--- Collection des FormatConditions ---
Set CollFCS = New Collection
'---
On Error Resume Next
Set R = ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions)
If Err <> 0 Then
MsgBox prompt:="Dans ''" & ActiveSheet.Name & "'' aucune MFC n'a été trouvée.", Title:="Erreur " & Err.Number & " " & Err.Description
Exit Sub
End If
On Error GoTo 0
For Each C In R
For i& = 1 To C.FormatConditions.Count
On Error Resume Next
CollFCS.Add Item:=C.FormatConditions(i&), Key:=i& & "" & C.FormatConditions(i&).AppliesTo.Address
On Error GoTo 0
Next i&
Next C
'--- Les MFCs ---
For i& = 1 To CollFCS.Count
Set FC = CollFCS(i&)
'--- Plage où s'opère la MFC ---
Set R = FC.AppliesTo
'--- Formule ---
maFormule$ = FC.Formula1
'°°° Récupérer le format dela formule autrement qu'en FormatLocal °°°
With ActiveSheet.Range("iv65536")
.FormulaLocal = maFormule$
maFormule$ = .Formula
Set RPrecedent = .Precedents
.ClearContents
End With
'°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
'--- Balayage de la plage Et récupération des cellules où s'opère la MFC ---
For Each C In R
A$ = Replace(maFormule$, RPrecedent.Address(False, False), C.Address(False, False))
If Evaluate(A$) <> 0 Then
If Plage Is Nothing Then
Set Plage = C
Else
Set Plage = Application.Union(Plage, C)
End If
End If
Next C
Next i&
'--- Affichage du résultat ---
If Not R Is Nothing Then
Plage.Select
MsgBox "Nombre de cellules avérées : " & Plage.Cells.Count
End If
End Sub
