Equivalent de code

Désolé pour le post, je m'ai trompé ;-))

"Nicolas" <nicolasheurtevin@wanadoo.fr> a écrit dans le message de
news:079c01c3c571$fc218f60$a401280a@phx.gbl

Bonjour,

Je cherche l'équivalent de ce code pour qu'il fonctionne
sous Access 2000 :

For i = 0 To Printer.FontCount - 1
MsgBox Printer.Fonts(i)
Next i

Bonjour/soir,

tu peux essayer par APIs:
Public Enum CharSets
ANSI_CHARSET = 0
DEFAULT_CHARSET = 1
SYMBOL_CHARSET = 2
SHIFTJIS_CHARSET = 128
HANGEUL_CHARSET = 129
HANGUL_CHARSET = 129
GB2312_CHARSET = 134
CHINESEBIG5_CHARSET = 136
OEM_CHARSET = 255
JOHAB_CHARSET = 130
HEBREW_CHARSET = 177
ARABIC_CHARSET = 178
GREEK_CHARSET = 161
TURKISH_CHARSET = 162
VIETNAMESE_CHARSET = 163
THAI_CHARSET = 222
EASTEUROPE_CHARSET = 238
RUSSIAN_CHARSET = 204
MAC_CHARSET = 77
BALTIC_CHARSET = 186
End Enum

Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64

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 As String * LF_FACESIZE
End Type

Private Type TEXTMETRIC
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
End Type

Private Declare Function EnumFontFamiliesEx _
Lib "gdi32" _
Alias "EnumFontFamiliesExA" _
( _
ByVal hdc As Long, _
lpLogfont As LOGFONT, _
ByVal lpEnumFontFamExProc As Long, _
ByVal LParam As Long, _
ByVal dwFlags As Long _
) _
As Long

Private Declare Function GetDC _
Lib "user32" _
( _
ByVal hWnd As Long _
) _
As Long

Sub Test()
Dim udtLF As LOGFONT

udtLF.lfCharSet = DEFAULT_CHARSET
udtLF.lfFaceName = String$(LF_FACESIZE, vbNullChar)
udtLF.lfPitchAndFamily = 0

EnumFontFamiliesEx GetDC(0), udtLF, AddressOf EnumFontFamExProc, 0, 0

End Sub
Function EnumFontFamExProc _
( _
lpelfe As LOGFONT, _
lpntme As TEXTMETRIC, _
ByVal FontType As Long, _
ByVal LParam As Long _
) _
As Long

Dim strBuffer As String

strBuffer = StrConv(lpelfe.lfFaceName, vbUnicode)
If InStr(1, strBuffer, vbNullChar) > 0 Then
strBuffer = Left$(strBuffer, InStr(1, strBuffer, vbNullChar) - 1)
End If

Debug.Print strBuffer

EnumFontFamExProc = 1 'pour arrêter l'énumération, utiliser 0
End Function

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com