Get list of available fonts

Private Sub CreateFontList()
' populate a list with system fonts
Dim Cnt As Long
Dim s1 As String
For Cnt = 1 To Screen.FontCount
  s1 = Screen.Fonts(Cnt)

   If s1 <> "" Then List1.AddItem s1
Next
List1.ListIndex = 0
End Sub