Подскажите пожалуйста, как на созданной мною форме в поле с выпадающим списком в качестве источника строк получить список шрифтов (который отображается в Word при выборе шрифтов).
- Сделал для примера файл, т.к. нужен модуль для сортировки шрифтов, т.к. шрифты возвращаются не по алфавиту.
- Макрос запускайте из VBA, из модуля формы.
- Ворд возвращает ещё шрифты, которые начинаются символом "@". Если вам не нужны они, то нужно внести изменения в макрос.
Код для формы
Private Sub CommandButton1_Click()
Dim arr(), i As Long
'1. Создание ячеек в массиве "arr".
ReDim arr(1 To Application.FontNames.Count)
'2. Запись шрифтов, известных программе "Word", в массив "arr".
For i = 1 To Application.FontNames.Count Step 1
arr(i) = Application.FontNames(i)
Next i
'3. Сортировка шрифтов по алфавиту (в коллекции "FontNames" шрифты отсортированы
' по какому-то другому принципу).
Call Module1.mySort(arr())
'4. Копирование данных из массива в комбобокс.
Me.ComboBox1.List = arr()
End Sub
[вложение удалено администратором]
Замечательно! Большое спасибо! Все хорошо! Если Вас не затруднит, сделайте еще вариант без шрифтов со знаком "@". Я их никогда не использую.
Макрос
Private Sub CommandButton1_Click()
Dim arr(), i As Long, r As Long
'1. Создание ячеек в массиве "arr".
ReDim arr(1 To Application.FontNames.Count)
'2. Запись шрифтов, известных программе "Word", в массив "arr".
For i = 1 To Application.FontNames.Count Step 1
' Стили, которые начинаются "@", не берутся.
If Left(Application.FontNames(i), 1) <> "@" Then
r = r + 1
arr(r) = Application.FontNames(i)
End If
Next i
'3. Удаление с конца пустых элементов, которые остались из-за стилей, начинающихся "@".
ReDim Preserve arr(1 To r)
'4. Сортировка шрифтов по алфавиту (в коллекции "FontNames" шрифты отсортированы
' по какому-то другому принципу).
Call Module1.mySort(arr())
'5. Копирование данных из массива в комбобокс.
Me.ComboBox1.List = arr()
End Sub
Большое спасибо!