Word позволяет использовать шрифты, установленные в используемой вами системе. Шрифты устанавливаются в Windows, поэтому они доступны не только для Word, но и для всех программ, установленных в вашей системе.
Когда вы создаете документ в своей системе, легко узнать, что используются шрифты – список шрифтов ограничен теми, которые доступны в системе. Однако, если вы получили документ от другого человека, в его системе могут быть установлены шрифты, отличные от ваших. Это означает, что их документ Word может быть отформатирован с использованием шрифтов, которых у вас даже нет в вашей системе.
Если вы хотите создать список шрифтов, используемых в документе (в отличие от списка шрифты, доступные в системе), у вас есть несколько вариантов. Прежде всего, вы можете открыть документ Word в текстовом редакторе и просмотреть те части документа, которые обычно не отображаются в Word. Ближе к концу файла вы должны увидеть список шрифтов, используемых в документе. Однако если вы это сделаете, вы должны быть очень осторожны, чтобы не вносить никаких изменений в документ Word, пока он открыт в вашем текстовом редакторе. Это может легко сделать документ непригодным для использования в Word.
Решение на основе Word состоит в том, чтобы просто просмотреть каждый символ в документе и проверить, какой шрифт используется для форматирования символа. Посимвольный подход необходим, потому что каждый символ может быть отформатирован с помощью другого шрифта, а VBA не позволяет вам получить доступ к коллекции шрифтов по отношению к самому документу – похоже, что такая коллекция не поддерживается. Таким образом, самый безопасный (и самый медленный) метод – просто пройти по каждому символу и создать свой собственный список. Следующий макрос VBA выполняет задачу:
Public Sub ListFontsInDoc () Dim FontList (199) As String Dim FontCount As Integer Dim FontName As String Dim J As Integer, K As Integer, L As Integer Dim X до длины, Y до длины Dim FoundFont As Boolean Dim rngChar As Range Dim strFontList As String FontCount = 0 X = ActiveDocument.Characters.Count Y = 0 'Цикл For-Next по каждому символу For Each rngChar In ActiveDocument.Characters Y = Y + 1 FontName = rngChar.Font.Name StatusBar = Y & ":" & X 'проверяет, есть ли шрифт, используемый для этого символа, уже в списке FoundFont = False For J = 1 To FontCount If FontList (J) = FontName Then FoundFont = True Next J Если Not FoundFont Then FontCount = FontCount + 1 FontList (FontCount) = FontName End If Next rngChar 'сортирует список StatusBar = "Сортировка списка шрифтов" Для J = 1 в FontCount - 1 L = J Для K = J + 1 в FontCount Если FontList (L)> FontList (K) Тогда L = K Далее K Если J L Тогда FontName = FontList (J) FontList (J) = FontList (L) FontList (L) = FontName End If Next J StatusBar = "" 'поместить в новый документ Documents.Add Selection.TypeText Text: = "В документе используются шрифты" & _ FontCount & " , а именно: "Выбор. TypeParagraph Selection.TypeParagraph For J = 1 To FontCount Selection.TypeText Text: = FontList (J) Selection.TypeParagraph Next JEnd Sub
Очевидно, чем длиннее ваш документ, тем больше времени потребуется макросу на финиш. (Я запустил макрос для документа на 1100 страниц, и это заняло примерно 46 минут. Для 5-страничного документа это заняло меньше минуты.) Когда закончите, макрос создает новый документ, содержащий отсортированный список используемых шрифтов.