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