Type Styles_Et_Formats
Styles_Utilises As Long
DeltaAvecLeStyle As Long
MEFC As Long
End Type
Dim D As Object
Sub TestNFSC()
Dim r As Styles_Et_Formats
r = NbFormatsSurClasseur(ActiveWorkbook)
MsgBox ActiveWorkbook.Name & ":" & vbNewLine & _
"==>" & vbTab & r.DeltaAvecLeStyle & _
" cellules avec formats particuliers" & vbNewLine & _
"==>" & vbTab & r.Styles_Utilises & _
" styles précis utilisés" & vbNewLine & _
"==>" & vbTab & r.MEFC & " MEFC."
End Sub
Function NbFormatsSurClasseur(Classeur As Workbook) As Styles_Et_Formats
Dim Feuille As Worksheet
Dim n As Long, fc As Long, r As Styles_Et_Formats
n = 0: fc = 0
Set D = CreateObject("Scripting.Dictionary")
For Each Feuille In ActiveWorkbook.Worksheets
r = NbFormatsSurFeuille(Feuille)
n = n + r.DeltaAvecLeStyle
fc = fc + r.MEFC
Next Feuille
NbFormatsSurClasseur.DeltaAvecLeStyle = n
NbFormatsSurClasseur.MEFC = fc
NbFormatsSurClasseur.Styles_Utilises = D.Count
Set D = Nothing
End Function
Function NbFormatsSurFeuille(sht As Worksheet) As Styles_Et_Formats
Dim Cell As Range, nomStyle As String, Res As Styles_Et_Formats
Res.MEFC = 0: Res.DeltaAvecLeStyle = 0
For Each Cell In sht.UsedRange
nomStyle = Cell.Style.Name
If Not D.exists(nomStyle) Then D.Add nomStyle, 1
With ActiveWorkbook.Styles(nomStyle)
If Cell.NumberFormat <> .NumberFormat Or _
Cell.HorizontalAlignment <> .HorizontalAlignment Or _
Cell.VerticalAlignment <> .VerticalAlignment Or _
Cell.Borders.Value <> .Borders.Value Or _
Cell.Locked <> .Locked Or _
Cell.Interior.ColorIndex <> .Interior.ColorIndex Or _
Cell.Interior.Pattern <> .Interior.Pattern Or _
Cell.Font.Name <> .Font.Name Or _
Cell.Font.Size <> .Font.Size Or _
Cell.Font.Bold <> .Font.Bold Or _
Cell.Font.Italic <> .Font.Italic Or _
Cell.Font.ColorIndex <> .Font.ColorIndex Then
Res.DeltaAvecLeStyle = Res.DeltaAvecLeStyle + 1
End If
Res.MEFC = Res.MEFC + Cell.FormatConditions.Count
End With
Next Cell
NbFormatsSurFeuille = Res
End Function
