Форум по VBA и MS Office

Sub Макрос()

    Dim FontsComboBox As CommandBarComboBox, fonts()
    Dim i As Long
   
    '1. Создание ссылки на элемент, который находился на панели инструментов "Форматирование".
        ' Эта панель была в Excel 2003. Сейчас её не видно, но она существует.
    Set FontsComboBox = Application.CommandBars("Formatting").FindControl(ID:=1728)
   
    '2. Создание ячеек в массиве "fonts".
    ReDim fonts(1 To FontsComboBox.ListCount)
   
    '3. Запись шрифтов в массив "fonts".
    For i = 1 To FontsComboBox.ListCount
        fonts(i) = FontsComboBox.List(i)
    Next
   
End Sub

Sub Макрос2()

    Dim WordApp As Object, font As String, i As Long
   
   
    '1. Запускаем программу "Word" и присваиваем ей имя "WordApp".
        ' Далее в коде будем работать с вордом, используя имя "WordApp".
    Set WordApp = CreateObject(Class:="Word.Application")
   
    '2. Цикл по шрифтам. Не знаю, где эти шрифты находятся в ворде.
    For i = 1 To WordApp.FontNames.Count
   
        '1) Запись шрифта в переменную, чтобы два раза не обращаться к объекту.
            ' Так удобнее, на первый взгляд.
        font = WordApp.FontNames(i)
       
        '2) Есть шрифты, у которых спереди символ "@". Не знаю, что это означает.
            ' Такие шрифты не будем получать.
        If Left(font, 1) <> "@" Then
            ' Запись шрифта в View - Immediate Window.
            Debug.Print font
        End If
       
    Next i
   
    '3. Закрытие программы "Word".
    ' SaveChanges:=False - делается на всякий случай.
        ' Мы не делали изменений, но вдруг какие-то изменения всё-таки произошли; чтобы не было сообщения,
        ' предлагающего сохранить изменения.
    WordApp.Quit SaveChanges:=False
   
End Sub