Option Explicit

Private Sub UserForm_Initialize()
  Dim avarFonts As Variant
  Dim avarArray As Variant
  Dim strText   As String

  avarFonts = GetFontsList
  With Me.cboFontNames
    .Clear
    If IsArray(avarFonts) Then
      .List = avarFonts
      Erase avarFonts
      .ListIndex = 0
    Else
      Call DisableControls
      Exit Sub
    End If
  End With

  avarArray = Array(8, 9, 10, 11, 12, 14, 16, 18, 20, 24, 28, 36)
  With Me.cboFontSize
    .Clear

    .ColumnCount = 1
    .ColumnWidths = "10"
    .ListWidth = 36

    .List = avarArray
    .Text = "14"
  End With

  strText = "abcdefghijklmnopqrstuvwxyz "
  Me.txtPreview.Text = UCase$(strText) & vbCr & LCase$(strText)
End Sub

Private Function GetFontsList() As Variant
  Dim cbrBar    As CommandBar
  Dim cbcFont   As CommandBarControl

  Dim avarFonts As Variant
  Dim nCnt      As Long

  On Error GoTo err_GetFonts

  Set cbcFont = Application.CommandBars.FindControl(ID:=1728)
  If cbcFont Is Nothing Then
    Set cbrBar = Application.CommandBars.Add( _
          "MyDummy", msoBarFloating, False, True)
    Set cbcFont = cbrBar.Controls.Add(ID:=1728)
  End If

  ReDim avarFonts(1 To cbcFont.ListCount)
  For nCnt = 1 To cbcFont.ListCount
    avarFonts(nCnt) = cbcFont.List(nCnt)
  Next
  If IsArray(avarFonts) Then
    GetFontsList = avarFonts
  End If

err_GetFonts:
  If Not cbrBar Is Nothing Then cbrBar.Delete
  Set cbrBar = Nothing
  Set cbcFont = Nothing
  On Error GoTo 0
End Function

Private Function DisableControls()
  Dim ctl As Control

  For Each ctl In Me.Controls
    ctl.Enabled = False
  Next

  With Me.cmdClose
    .Enabled = True
    .Default = True
  End With
End Function

Private Sub cboFontNames_Click()
  With Me.txtPreview.Font
    .Name = Me.cboFontNames.Text
    .Charset = 2
  End With
End Sub

Private Sub cboFontSize_Change()
  Me.txtPreview.Font.Size = Val(Me.cboFontSize.Text)
End Sub

Private Sub chkBold_Click()
  Me.txtPreview.Font.Bold = Me.chkBold.Value
End Sub

Private Sub chkItalic_Click()
  Me.txtPreview.Font.Italic = Me.chkItalic.Value
End Sub