Макрос VBA для печати всех стилей шрифтов, используемых в текстовом документе - PullRequest
Новая
       21

Макрос VBA для печати всех стилей шрифтов, используемых в текстовом документе

1 голос
/ 08 декабря 2011

Чтобы проверить некоторые текстовые документы на предмет согласованного форматирования, я хотел бы получить список всех различных шрифтов, которые используются / применяются к определенному документу. Я не мог найти вариант для этого в графическом интерфейсе, но можно ли это сделать программно с VBA? У меня нет опыта работы с VBA, но какой-то псевдокод, подобный этому, должен работать, верно? 

all_fonts = []
for paragraph in all_paragraphs
    for each word in paragraph
       if word.style not in all_fonts
           all_fonts.append(word.style)


print all_fonts

Ответы [ 2 ]

3 голосов
/ 08 декабря 2011

Да: есть реализация чтения всех шрифтов из документа здесь , которая следует этому шаблону.

0 голосов
/ 16 июля 2019

Искал что-то вроде этого Сам:

Печатает список шрифтов и размеров 

Sub Font_Size()

Dim lw() As Variant
Dim exists As Boolean
Dim stry As Object
Dim sen As Object
Dim wd As Object

ReDim Preserve lw(1 To 2, 1 To 1): lw(1, 1) = "Size": lw(2, 1) = "Font Name"

For Each stry In ActiveDocument.StoryRanges

    For Each sen In stry.Sentences

        For Each wd In sen.Words

                exists = False

                For i = LBound(lw, 2) To UBound(lw, 2)

                    If wd.Font.Size = lw(1, i) And wd.Font.Name = lw(2, i) Then
                        exists = True
                        Exit For
                    End If

                Next

                If Not exists Then

                        ReDim Preserve lw(1 To 2, 1 To UBound(lw, 2) + 1)
                        lw(1, UBound(lw, 2)) = wd.Font.Size
                        lw(2, UBound(lw, 2)) = wd.Font.Name
                        'Debug.Print lw(1, UBound(lw, 2)), lw(2, UBound(lw, 2))

                End If

        Next

    Next

Next


For i = LBound(lw, 2) To UBound(lw, 2)
    Debug.Print lw(1, i), lw(2, i)
Next

End Sub
...