Sub Recherche_Police()
    Dim i As Long
With Application.CommandBars.FindControl(ID:=1728)
    For i = 1 To .ListCount
        Debug.Print .List(i)
    Next i
End With
End Sub

Private Sub Recherche_Police()
Dim i As Long
For i = 0 To Screen.FontCount - 1
    Debug.Print Screen.Fonts(i)
Next
End Sub

'   A METTRE IMPéRATIVEMENT  DANS UN MODULE
Option Explicit
Private Const LF_FACESIZE   As Long = 32&
'
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(LF_FACESIZE) As Byte
End Type
'
Public 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
'
Public Function EnumFontProc(ByVal lplf As Long, ByVal lptm  As Long, ByVal dwType As Long, ByVal lpData As Long) As  Long
    Dim LF          As LOGFONT
    Dim ZeroPos     As Long
    Dim FontName    As String
    
    Call CopyMemory(LF, ByVal lplf, LenB(LF))
    FontName = StrConv(LF.lfFaceName, vbUnicode)
    ZeroPos = InStr(1, FontName, Chr$(0))
    If ZeroPos > 0 Then Debug.Print Left$(FontName, ZeroPos - 1)
    EnumFontProc = True
End Function


'    EXEMPLE D'UTILISATION
Private Sub Form_Load()
    Call EnumFonts(Me.hdc, vbNullString, AddressOf EnumFontProc, 0&)
End Sub

For Each Font As System.Drawing.FontFamily In System.Drawing.FontFamily.Families

  System.Console.WriteLine(Font.Name)

Next

foreach (System.Drawing.FontFamily Font in System.Drawing.FontFamily.Families)

  System.Console.Write(Font);

// Liste des  polices dans une liste
ListeAjoute(Liste1, PoliceListe())