Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel VBA & Liste des polices

VBA & Liste des polices

3 réponses
Avatar
Patrick Fredin
Bonjour,

Est-il possible de récupérer la liste des polices installées sur le poste...
en VBA ?

Merci.

--
Patrick
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Clément Marcotte
Bonjour,

Oui, pour autant que Word soit sur le poste:

http://support.microsoft.com/?scid=kb;fr;170970

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q209205




"Patrick Fredin" a écrit dans le message
de news:
Bonjour,

Est-il possible de récupérer la liste des polices installées sur le
poste...
en VBA ?

Merci.

--
Patrick


Avatar
Daniel.j
Des exemples ici:
http://dj.joss.free.fr/faq.htm#listpolice

Daniel

--
===================== FAQ MPFE
http://dj.joss.free.fr/faq.htm
=====================
"Patrick Fredin" a écrit dans le message
de news:
Bonjour,

Est-il possible de récupérer la liste des polices installées sur le
poste...
en VBA ?

Merci.

--
Patrick


Avatar
Michel Pierron
Bonjour Patrick;
Pour la liste Excel, tu récupères la liste existante du ComboBox de la barre
d'outils Format:

Sub FontListRecup()
On Error Resume Next
Dim FontList As CommandBarComboBox, i%
Set FontList = Application.CommandBars("Formatting").FindControl(ID:28)
If Err Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Add
For i = 1 To FontList.ListCount
Cells(i, 1) = FontList.List(i)
Next i
1: Set FontList = Nothing
End Sub

'------------------------------------------------------------------------
Pour La liste des polices installées, si tu as une version supérieure à
xl97, tu colles le code ci-dessous dans un module standard:

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(32) As Byte
End Type

Private Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type

Private Declare Function EnumFontFamilies& Lib "gdi32" _
Alias "EnumFontFamiliesA" (ByVal hDC&, ByVal lpszFamily$ _
, ByVal lpEnumFontFamProc&, lParam As Any)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd&)
Private i&

Private Function EnumFontProc&(LF As LOGFONT _
, NTM As NEWTEXTMETRIC, ByVal FontType&, lParam&)
Dim FontName As String
FontName = StrConv(LF.lfFaceName, vbUnicode)
i = i + 1
Cells(i, 1) = Left$(FontName, InStr(FontName, vbNullChar) - 1)
EnumFontProc = 1
End Function

Sub FontsList()
Application.ScreenUpdating = False
Workbooks.Add: i = 0
EnumFontFamilies GetDC(0), vbNullString, AddressOf EnumFontProc, 0
Cells.Sort [A1], 1
End Sub

MP

"Patrick Fredin" a écrit dans le message
de news:
Bonjour,

Est-il possible de récupérer la liste des polices installées sur le
poste...
en VBA ?

Merci.

--
Patrick