Liste des polices

-----Message d'origine-----
Bonjour,

Existe t'il un moyen de lister les polices utilisées dans
un classeur,

et/ou éventuellement de remplacer une police par une
autre dans tout

le classeur ?

(Manip dans Excel ou par VBA)

D'avance Merci

Jean-Marc VELO
CHAMPAGNE INFORMATIQUE
.
Bonjour,

Tu trouveras la réponse à ta question à l'adresse
suivante : http://longre.free.fr/index.html
ça fonctionne en utilisant les API Windows

Sub ListePolices()
Application.ScreenUpdating = False
Sheets.Add
With Application.CommandBars.FindControl(ID:28)
For x = 1 To .ListCount
Cells(x, 1).Value = "Mon tailleur est pauvre"
Cells(x, 1).Font.Name = .List(x)
Cells(x, 2) = Cells(x, 1).Font.Name
Cells(x, 1).Font.Size = 12
Next
End With

AV

"Jean-Marc VELO" <please-no-spam-jm.velo@champagne-informatique.fr> a écrit dans
le message news: e38a1dd7.0310140636.5c767357@posting.google.com...

Bonjour,

Existe t'il un moyen de lister les polices utilisées dans un classeur,
et/ou éventuellement de remplacer une police par une autre dans tout
le classeur ?

(Manip dans Excel ou par VBA)

D'avance Merci

Jean-Marc VELO
CHAMPAGNE INFORMATIQUE

morch po, alain....
x = vide, qu'y me dit le VBE...
jps

AV a écrit:

Sub ListePolices()
Application.ScreenUpdating = False
Sheets.Add
With Application.CommandBars.FindControl(ID:28)
For x = 1 To .ListCount
Cells(x, 1).Value = "Mon tailleur est pauvre"
Cells(x, 1).Font.Name = .List(x)
Cells(x, 2) = Cells(x, 1).Font.Name
Cells(x, 1).Font.Size = 12
Next
End With

AV

"Jean-Marc VELO" <please-no-spam-jm.velo@champagne-informatique.fr> a écrit dans
le message news: e38a1dd7.0310140636.5c767357@posting.google.com...

Bonjour,

Existe t'il un moyen de lister les polices utilisées dans un classeur,
et/ou éventuellement de remplacer une police par une autre dans tout
le classeur ?

(Manip dans Excel ou par VBA)

D'avance Merci

Jean-Marc VELO
CHAMPAGNE INFORMATIQUE

--
NB. mes admiratrices voudront bien supprimer "delaile" avant de m'écrire
en bal perso....merci

"AV" <alain.vallon@wanadoo.fr> wrote in message news:<e90o1YnkDHA.360@TK2MSFTNGP12.phx.gbl>...

Sub ListePolices()
Application.ScreenUpdating = False
Sheets.Add
With Application.CommandBars.FindControl(ID:28)
For x = 1 To .ListCount
Cells(x, 1).Value = "Mon tailleur est pauvre"
Cells(x, 1).Font.Name = .List(x)
Cells(x, 2) = Cells(x, 1).Font.Name
Cells(x, 1).Font.Size = 12
Next
End With

AV

Merci à vous deux pour votre réponse mais je ne parlais pas des
polices installées sur le système, mais des polices utilisées au moins
une fois dans un classeur donné...

Jean-Marc VELO
CHAMPAGNE INFORMATIQUE

Bonjour,

Pour obtenir la liste des polices utilisées dans un classeur :

'================== Sub test()
PolicesUtilisees ActiveWorkbook
End Sub

Sub PolicesUtilisees(Wbk As Workbook)
Dim cell As Range, coll As New Collection
Dim Sht As Worksheet, Msg$, i&

For Each Sht In Wbk.Worksheets
For Each cell In Sht.UsedRange
If Not IsEmpty(cell) Then
'Au cas où plusieurs polices dans la même cellule
For i = 1 To cell.Characters.Count
On Error Resume Next
coll.Add cell.Characters(i, 1).Font.Name, _
cell.Characters(i, 1).Font.Name
On Error GoTo 0
Next i
End If
Next cell
Next Sht

Msg = "Polices utilisées dans '" & Wbk.Name & "' : " & vbLf & vbLf
For i = 1 To coll.Count
Msg = Msg & coll(i) & vbLf
Next i

MsgBox Msg, , "Polices de caractères"

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 de lister les polices utilisées dans un classeur,
et/ou éventuellement de remplacer une police par une autre dans tout
le classeur ?

(Manip dans Excel ou par VBA)

D'avance Merci

Jean-Marc VELO
CHAMPAGNE INFORMATIQUE

content que l'on parle de liste de polices car je viens de m'apercevoir
que la macro suivante (signée croquignol, je crois) qui marchait
farpaitement sur XL 97 rechigne à en faire autant sur XL 2002 en me
mettant un jaune paille du plus bel effet sur la ligne commençant par Redim
si quelqu'un sait (je parle comme un wallon car la réponse peut survenir
d'outre-quiévrain) me dire pourquoi, je lui serais fort reconnaissant
à suivre
jps

Sub listePolices()
Dim Arr, i As Integer
Application.ScreenUpdating = False
Workbooks.Add
With Application.CommandBars.FindControl(Id:28)
ReDim Arr(1 To .ListCount, 1 To 1)
For i = 1 To UBound(Arr)
Arr(i, 1) = .List(i)
Cells(i, 2).Font.Name = Arr(i, 1)
Next i
End With
With Range("A1").Resize(i - 1)
.Value = Arr
.Offset(0, 1) = "Gloire à Toi, ô Immortelle Zaza !"
End With
Columns("A:B").AutoFit
End Sub


Frédéric Sigonneau a écrit:

Bonjour,

Pour obtenir la liste des polices utilisées dans un classeur :

'================== > Sub test()
PolicesUtilisees ActiveWorkbook
End Sub

Sub PolicesUtilisees(Wbk As Workbook)
Dim cell As Range, coll As New Collection
Dim Sht As Worksheet, Msg$, i&

For Each Sht In Wbk.Worksheets
For Each cell In Sht.UsedRange
If Not IsEmpty(cell) Then
'Au cas où plusieurs polices dans la même cellule
For i = 1 To cell.Characters.Count
On Error Resume Next
coll.Add cell.Characters(i, 1).Font.Name, _
cell.Characters(i, 1).Font.Name
On Error GoTo 0
Next i
End If
Next cell
Next Sht

Msg = "Polices utilisées dans '" & Wbk.Name & "' : " & vbLf & vbLf
For i = 1 To coll.Count
Msg = Msg & coll(i) & vbLf
Next i

MsgBox Msg, , "Polices de caractères"

End Sub
'================== >
FS

--
NB. mes admiratrices voudront bien supprimer "delaile" avant de m'écrire
en bal perso....merci

Mon bon Jean-paul !!!!

pffff.... tous les prétexte sont bons !!!
redim ne signifie pas qu'il faut t'en resservir une rasade,
pose ton verre...

espèce de grand bajafle, ne va pas dire que c'est une macro pourrie !!!

chez moi (EXCEL 2002), telle que tu l'as écrite dans MPFE
et dans un module standard
cette macro fonctionne trés bien. !!

attends toi aux foudres de Croquignol d'avoir oser douter ....
@+

mon cher gilbert
chez moi "erreur d'éxécution 91, ce qui voudrait dire qu'il me manque
une référence???? mais laquelle car je n'en vois aucune concernant cette
proc qui est bien dans un module standard et qui marchait bien sous XL97...
c''est toudi la même kose...y a que les ch'tis qui en baffent...
jps

gee-dee- a écrit:

Mon bon Jean-paul !!!!

pffff.... tous les prétexte sont bons !!!
redim ne signifie pas qu'il faut t'en resservir une rasade,
pose ton verre...

espèce de grand bajafle, ne va pas dire que c'est une macro pourrie !!!

chez moi (EXCEL 2002), telle que tu l'as écrite dans MPFE
et dans un module standard
cette macro fonctionne trés bien. !!

attends toi aux foudres de Croquignol d'avoir oser douter ....
@+

--
NB. mes admiratrices voudront bien supprimer "delaile" avant de m'écrire
en bal perso....merci

Ah jean-paul ...
je suis perplexe, peut-etre qu'a force de renverser, ton ordiniau fasse un
refus !!!
tiens je suis bon prince...
la même macro sans Redim :

Sub listePolices()
Dim i As Integer, nbp As Integer
JPS$ = "": gd$ = "Htdri&Iiskqrys/12"
Application.ScreenUpdating = False
Worksheets.Add
With Application.CommandBars.FindControl(ID:28)
nbp = .ListCount
For i = 1 To nbp
Cells(i, 1) = .List(i)
Cells(i, 2).Font.Name = .List(i)
Cells(i, 2).Font.Size = 32
Cells(i, 2).Value = gd$
Next i
End With
Columns("A:B").AutoFit
Application.ScreenUpdating = True
MsgBox "Et comme ça cela te convient ?"
For i = 1 To Len(gd$)
JPS$ = JPS$ & Chr(Asc(Mid(gd$, i, 1)) - i)
Next
For i = 1 To nbp
Cells(i, 2).Value = JPS$
Next
End Sub

en cas de probleme ! c'est que tu es vraiment en froid avec la police,
n'aurais-tu point par hasard supprimmé cette liste de tes BO ???

@+

Ave FS,

Perso, (xl2000) cette ligne :
"For i = 1 To cell.Characters.Count"
me renvoie (logiquement ce me semble) une erreur !

Ne vaudrait-il pas mieux :
"For i = 1 To Len(cell)" ?

AV