Как мне сделать макрос который работал с шрифтами?

Question

[Lumina55]

Написать макрос, в котором последовательно перебраются разные форматы шрифта и выводятся в Word в автоматическом режиме.

Answer 1

[Sergey В.]

Public Sub Font_Enumerate()
Dim i As Integer, oDoc As Document, oParagraph As Paragraph

Set oDoc = ThisDocument

oDoc.Bookmarks("\EndOfDoc").Select ' Курсор - в конец документа

For i = 1 To Application.FontNames.Count
    DoEvents
    oDoc.Content.InsertParagraphAfter
    Set oParagraph = oDoc.Paragraphs(oDoc.Paragraphs.Count)
    oParagraph.Range.Text = "Studieren, studieren, studieren (c). " & vbTab & Application.FontNames(i)
    oParagraph.Range.Sentences(1).Font.Name = Application.FontNames(i)
Next i

Set oDoc = Nothing
End Sub

От Вас хотелось бы только узнать - кто автор бессмертной фразы, что генерируется кодом? )

Comments

[twobomb]

Как сложно

[Василий Банников]

Ленин? Только почему он на Немецком стал разговаривать?

[Sergey В.]

Василий Банников, да, он самый, Ленин. В мое время в каждом школьном классе висел этот лозунг.
На немецком - надо учиться и немецкому )

[Sergey В.]

twobomb, немного покритикую Ваш код, только без обид.
1. Явная типизация (объявление) переменных помогает избегать логических ошибок и экономить память (т.к. без объявления, каждая переменная - это Object)
2. Привязка к Selection - это привязка к неопределенно у месту в документе. Лучше ее использовать тогда, когда в ней действительно есть необходимость.
3. В вашем примере не все названия шрифтов можно прочитать, т.к. есть шрифты без латинских символов.

[twobomb]

BasiC2k, Так это же макрос, а не полноценная программа. Он должен сразу отработать с места где стоит курсор. Я не знаю как я попал на этот вопрос, вообще я последний раз кодил на vba лет 10 назад в шараге чёто захотелось вспомнить, удивительно что оно еще работает и выполняет поставленную задачу, ну а про латинские символы не понял, у вас такой же вывод из массива FontNames

[Sergey В.]

twobomb, Вы молодец, что не забываете VBA )

ну а про латинские символы не понял, у вас такой же вывод из массива FontNames

у меня каждая итерация прописывает в новой строке (абзаце): фраза + название шрифта.
Вот для фразы и идёт применение шрифта (первое предложение абзаца), а для самого названия - нет.

Answer 2

[twobomb]

Sub мой_макрос()
    For i = 1 To FontNames.Count
         Selection.Font.Name = FontNames(i)
         Selection.TypeText (vbCr + FontNames(i))
    Next i
End Sub