Nombre de formats de cellules

Bonjour Jean Marc,

Tu te dois de définir quel format de cellules tu veux décompter ? Parce que vois-tu, il y a une très grande possibilité
de formatage de cellules que ce soit seulement la couleur des caractères, du fond de la cellule, de la grosseur des
caractères.. souligné ou pas, avec ou sans lignes de contour, de l'épaisseur de cette ligne et ++++ etc ...

Je crois que je vais laisser AV se pencher sur cette question à son retour de sa ballade de vélo !

;-)


Salutations!



"Jean Marc VELO" <DELETEjmarcveloANTI-SPAM@yahoo.fr> a écrit dans le message de
news:Xns943B970AE1635DELETEjmarcveloANTIS@212.30.113.196...
Bonjour,

Existe t'il un moyen en VBA pour connaître le nombre de formats de cellules
différents d'un classeur ?

Ceci pour éviter l'erreur "Nombre de formats de cellules différents trop
élevé" qui empèche l'ouverture d'un classeur.

Merci.

Jean-Marc VELO

Je crois que je vais laisser AV se pencher sur cette question à son retour de
sa ballade de vélo !

Je suis en retard pour cause de crevaison et, de plus, quand je me "penche", ça
me donne le vertige ! ;-)
J'ai jamais eu ce problème de "Nombre de formats de cellules ...."
....donc j'évite de réfléchir à la question de savoir combien il y a de formats
différents dans mon classeur
Ca sent les bouclettes à perte de vue ...
;-)

AV

;-))


"AV" <alain.vallon@wanadoo.fr> a écrit dans le message de news:%23w%23KXYRsDHA.2464@TK2MSFTNGP12.phx.gbl...

Je crois que je vais laisser AV se pencher sur cette question à son retour de
sa ballade de vélo !

Je suis en retard pour cause de crevaison et, de plus, quand je me "penche", ça
me donne le vertige ! ;-)
J'ai jamais eu ce problème de "Nombre de formats de cellules ...."
....donc j'évite de réfléchir à la question de savoir combien il y a de formats
différents dans mon classeur
Ca sent les bouclettes à perte de vue ...
;-)

AV

Bonjour,

Une début de solution, sans doute à compléter, les possibilités de mises en
forme offertes par Excel étant fort variées :)

Sub test()
Dim sht As Worksheet, cell As Range
Dim NbFormats
NbFormats = 0
For Each sht In ActiveWorkbook.Worksheets
For Each cell In sht.UsedRange
With ActiveWorkbook.Styles("Normal")
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
NbFormats = NbFormats + 1
End If
End With
Next cell
Next sht
MsgBox NbFormats
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonjour,

Existe t'il un moyen en VBA pour connaître le nombre de formats de cellules
différents d'un classeur ?

Ceci pour éviter l'erreur "Nombre de formats de cellules différents trop
élevé" qui empèche l'ouverture d'un classeur.

Merci.

Jean-Marc VELO

Une début de solution, sans doute à compléter, les possibilités de mises en
forme offertes par Excel étant fort variées :)

Surtout si on ajoute les MFC ;-)

AV

Re,

En comptant les éventuelles conditions d'une MFC pour 1 format par condition :

Sub test()
Dim sht As Worksheet, cell As Range
Dim NbFormats
NbFormats = 0
For Each sht In ActiveWorkbook.Worksheets
For Each cell In sht.UsedRange
With ActiveWorkbook.Styles("Normal")
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
NbFormats = NbFormats + 1
End If
End With
NbFormats = NbFormats + cell.FormatConditions.Count
Next cell
Next sht
MsgBox NbFormats
End Sub

A suivre...

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Une début de solution, sans doute à compléter, les possibilités de mises en
forme offertes par Excel étant fort variées :)

Surtout si on ajoute les MFC ;-)

AV

Bonsoir,

-----message d'origine---
../..

Ceci pour éviter l'erreur "Nombre de formats de cellules différents trop
élevé" qui empèche l'ouverture d'un classeur.
../..

une des raisons évoquée à-propos du "nombre de format trop élévé", résiderai
????? dans l'utilisation des graphiques
que l'utilisateur redimensionnerait.... créant par là même autant de
variation de taille de police.
en effet il n'est pas rare (aussi bien pour les étiquettes que pour les
axes) de se retrouver avec des polices de taille décimale telles que : arial
6,5 ou times 3,5

en conséquence : pour chaque élément d'un graphe auquel est associé une
police
il existe une option "Echelle automatique" qu'il est préférable de
dés-activer
et de choisir soi-même la taille parmi celles proposées.

il me semble que ce conseil avait déja été proposé par notre Misange ;-)))

@+

Salut Frédéric,

En me basant sur ta proc, en voilà une autre qui a comme différence majeure de
comparer les attributs de la Cellule courante avec le STYLE de base de CETTE
Cellule.

Bénéfice non-négligeable: faire ressortir la pertinence d'utiliser des styles
:-)

J'hésite à y inclure les formats conditionnels car il faudrait être capable de
différencier ceux qui sont identiques d'une cellule à l'autre (car doit-on
vraiment les compter à chaque fois?, c'est pas clair pour moi).

Salutations,

Daniel M.


Dim D As Object

Type Styles_et_Formats
Styles_Utilises As Long
Formats_Particuliers As Long
End Type


Sub TestNFSC()
Dim R As Styles_et_Formats
R = NbFormatsSurClasseur(ActiveWorkbook)
MsgBox ActiveWorkbook.Name & ":" & vbNewLine & _
"==>" & vbTab & R.Formats_Particuliers & _
" cellules avec formats particuliers" & vbNewLine & _
"==>" & vbTab & R.Styles_Utilises & " styles précis utilisés."
End Sub


Function NbFormatsSurClasseur(Classeur As Workbook) As Styles_et_Formats
Dim sht As Worksheet, n As Long
n = 0
Set D = CreateObject("Scripting.Dictionary")
For Each sht In ActiveWorkbook.Worksheets
n = n + NbFormatsSurFeuille(sht)
Next sht
NbFormatsSurClasseur.Formats_Particuliers = n
NbFormatsSurClasseur.Styles_Utilises = D.Count
Set D = Nothing
End Function

Function NbFormatsSurFeuille(sht As Worksheet) As Long
Dim Cell As Range, sn As String
NbFormatsSurFeuille = 0
For Each Cell In sht.UsedRange
sn = Cell.Style.Name
If Not D.exists(sn) Then D.Add sn, 1

With ActiveWorkbook.Styles(sn)
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
NbFormatsSurFeuille = NbFormatsSurFeuille + 1
End If
End With
Next Cell
End Function

Bonjour,

En tenant compte des formats conditionnels mais pas de la façon optimale que je
voudrais. Ce sera à un autre de prendre le relais ;-)

Salutations,

Daniel M.

' +++++++++++++++++++++++++++++

Dim D As Object

Type Styles_Et_Formats
Styles_Utilises As Long
DeltaAvecLeStyle As Long
MEFC As Long
End Type


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
' +++++++++++++++++++++++++++++

......Ce sera à un autre de prendre le relais ;-)

Je voudrais bien mais comme il faudrait aussi passer en revue les divers objets
susceptibles de contenir du texte, plus les graphiques, plus les feuilles
graphiques, plus les boites de dial XL dans lesquelles on peut aussi insérer des
textes formatés, plus......
Finalement je laisse !

;-)
AV