Afficher des polices de caractère dans un ComboBox [Résolu]

Messages postés
141
Date d'inscription
mardi 18 mars 2003
Statut
Membre
Dernière intervention
3 octobre 2010
- - Dernière réponse : mortalino
Messages postés
6789
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
- 6 avril 2006 à 06:34
Bonjour à tous

Grace à l'API EnumFont, je peux afficher l'ensemble de mes polices dans un Combo.

Le truc, c'est que je ne voudrais afficher que celles présentes dans le répertoire C:\Windows\Fonts.
Mon problème est que la fonction EnumFont affiches l'ensemble des polices.

Pouvez-vous m'aider

ci-dessous le bout de code

Private Const LF_FACESIZE = 32
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(LF_FACESIZE) As Byte
End Type

Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
Dim LF As LOGFONT, FontName As String, ZeroPos As Long
CopyMemory LF, ByVal lplf, LenB(LF)
FontName = StrConv(LF.lfFaceName, vbUnicode)
ZeroPos = InStr(1, FontName, Chr$(0))
If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1)
Combo1.Add (FontName)
EnumFontProc = 1
End Function
Afficher la suite 

3 réponses

Meilleure réponse
Messages postés
15838
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
79
3
Merci
Utilise plutôt l'objet Printer pour énumérer tes polices : voir ma source permettant de visualiser les polices dans un listbox par exemple.

_
Avant de poster dans le forum,
prière d'aller lire ceci :
http://www.codes-sources.com/reglement.aspx
<s></s>

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 142 internautes nous ont dit merci ce mois-ci

Messages postés
586
Date d'inscription
jeudi 18 septembre 2003
Statut
Membre
Dernière intervention
13 février 2008
1
3
Merci
salut,
ou l'objet screen


<HR>

Life is short...Learn more
Copy Rights <> Rights to Copy

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 142 internautes nous ont dit merci ce mois-ci

Messages postés
6789
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
16
3
Merci
Salut

Essaie ça :

Sub Recherche_Police()

Dim i As Long, DLUcolA As Long
Sheets.Add
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Application.CommandBars.FindControl(ID:=1728)
For i = 1 To .ListCount
Cells(i, 1).Value = .List(i)
Cells(i, 2).Value = "Exemple"
' Cells(i, 2).Font.Name = .List(i)
' Cells(i, 2).Font.Size = 12
Next i
End With
Cells(1, 1).EntireColumn.AutoFit
DLUcolA = Columns(1).Find("", [A1], , , xlByRows, xlNext).Row - 1
Range("A1:A" & DLUcolA).Select
Selection.Copy
Sheets("Listes").Select (=> change le nom de la feuille)
Range("B2").Select
ActiveSheet.Paste
ActiveWorkbook.Names.Add Name:="ListePolices", RefersToR1C1:= _
"=Listes!R2C2:R" & DLUcolA + 1 & "C2"
Sheets("Feuil1").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

( Merci à ta4444 qui m'a donné le code récemment, je l'ai à peine modifié)
C'est trop fort
Pour l'exemple, j'ai appelé la Liste "ListePolices" donc après tu peux faire ComboBox1.RowSource = "ListePolices"

@++

Mortalino

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 142 internautes nous ont dit merci ce mois-ci