Private Sub GetFonts()
With Application.CommandBars("Formatting")
     If Not .FindControl(Id:=1728) Is Nothing Then
        With .FindControl(Id:=1728)
              ReDim iFonts$(1 To .ListCount)
              For iCount% = 1 To .ListCount
                  iFonts$(iCount%) = .List(iCount%)
              Next
        End With
     Else
        MsgBox "Вы удалили контрол, который содержит список всех шрифтов"
     End If
End With
End Sub