Вывод списка доступных шрифтов
При необходимости можно сформировать и вывести на печать список доступных в системе шрифтов. Для этого нужно написать и выполнить следующий макрос (листинг 3.101).
Листинг 3.101. Список шрифтов
Sub ListOfFonts()
Dim cbrcFonts As CommandBarControl
Dim cbrBar As CommandBar
Dim i As Integer
' Получение доступа к списку шрифтов (элемент управления в виде _
раскрывающегося списка на панели инструментов «Форматирование»)
Set cbrcFonts = Application.CommandBars(«Formatting»). _
FindControl(ID:=1728)
If cbrcFonts Is Nothing Then
' Панель «Форматирование» не открыта – откроем ее
Set cbrBar = Application.CommandBars.Add
Set cbrcFonts = cbrBar.Controls.Add(ID:=1728)
End If
' Подготовка к выводу шрифтов (очистка ячеек)
Range(«A:A»).ClearContents
' Вывод списка шрифтов в столбец "A" текущего листа
For i = 0 To cbrcFonts.ListCount – 1
Cells(i + 1, 1) = cbrcFonts.List(i + 1)
Next i
' Закрытие панели инструментов «Форматирование», если мы были _
вынуждены ее открывать
On Error Resume Next
cbrBar.Delete
End Sub
В результате работы данного макроса перечень доступных шрифтов будет сформирован на активном рабочем листе в столбце А. После этого список шрифтов можно по обычным правилам вывести на печать.