В более старых версиях Word (гораздо более старых, как в Word для Windows 2) была функция, позволяющая быстро распечатать список шрифтов в вашей системе. К сожалению, это уже не так. Однако вы можете довольно легко создать макрос, который может составить для вас такой список:
Sub ListFontNames () Dim J As Integer Dim NewDoc As Document ‘Создать новый документ Set NewDoc = Documents .Add ‘Добавить имена шрифтов в документ For J = 1 To FontNames.Count Selection.TypeText (FontNames (J)) Selection.TypeParagraph Next JEnd Sub
Макрос создает новый документ и затем просто выполняет шаги через коллекцию FontNames и добавляет каждое из имен в документ. Скорость, с которой работает макрос, зависит от того, сколько шрифтов вы установили в вашей системе.
Если вы хотите что-то более сложное, вы можете использовать следующий макрос. Он создает документ, но затем помещает все имена шрифтов в таблицу. Во втором столбце таблицы представлен отформатированный образец шрифта.
Sub FontExamples () Dim J As Integer Dim F As Integer Dim sTemp As String Dim sTest As String Dim Continue As Integer Dim rng As Range Dim FontTable As Table Dim NewDoc As Document ‘Укажите образец текста для второго столбца sTest = «ABCDEFG abcdefg 1234567890″‘ Проверьте, хочет ли пользователь продолжить F = FontNames.Count sTemp = «Есть» & F & «шрифты в этой системе». sTemp = sTemp & «Создание документа может занять довольно много времени». sTemp = sTemp & «Продолжить?» Continue = MsgBox (sTemp, vbYesNo, «Создать список шрифтов») Если Continue = vbYes Then ‘Объедините строку, содержащую содержимое таблицы sTemp = «Font Name» & vbTab & «Font Example» For J = 1 To F sTemp = sTemp & vbCr & FontNames (J) & vbTab & sTest Next J ‘Создать новый документ Set NewDoc = Documents.Add’ Добавить содержимое строки и преобразовать его в таблицу Set rng = Selection.Range rng.Text = sTemp Установить FontTable = rng.ConvertToTable (Separator: = vbTab, _ AutoFitBehavior: = wdAutoFitFixed) ‘Задайте общие свойства таблицы с помощью FontTable .Borders.Enable = False .Range.Font.Name = «Arial» .Range.Font.Size = 10 .Rows (1) .Range .Font.Bold = True .Rows (1) .Range.Font.Size = 12 End With ‘Пройдите по образцам ячеек и отформатируйте их For J = 1 To FontTable.Cell (J + 1, 2) .Range.Font .Name = FontNames (J) Next J ‘Сортировать таблицу FontTable.Sort SortOrder: = wdSortOrderAscending End IfEnd Sub
Этот макрос делает немного больше, чем предыдущий. Сама таблица создается довольно быстро, но может потребоваться много времени, чтобы пройти по каждой ячейке образца и отформатировать ее с использованием соответствующего шрифта. Вот почему макрос позволяет узнать, сколько шрифтов в вашей системе, прежде чем продолжить..
Независимо от того, какой макрос вы решите использовать, вы получите полный список шрифтов для вашей системы. Затем вы можете распечатать его и держать под рукой при работе с Word.
Источник: