I'm trying to create a Word document with the same paragraph in all the Word fonts. The macro to do this is printed below. I'm having a problem passing the all the Microsoft Word font names into my variant variable, fontlist. I've used the statement, 'fontList = ActiveDocument.FontNames' but that didn't work'. I've also tried, 'fontList = Application.FontNames' which didn't work either.

So I'd be grateful for any advice and suggestions as to how I can make the following macro work.

My thanks in advance

Sub CreateModernFontExamples()

    Dim fontList As Variant
    Dim i As Integer
    Dim MyText As String
        
    ' Get a list of available fonts
    
    *fontList = Application.FontNames* '***This is the problem statement***
    
    MyText = "The symbol for the English pound is '£'. The quick brown fox jumps over the lazy dog, a classic saying that showcases every letter of the alphabet. If you need a number sequence, try 1234567890, which includes all ten digits. You can even combine them to say, 'The fox leaped over the fence at 3:00 p.m.,' demonstrating both letters and numbers in a single sentence"
    
    ' Create a new paragraph for each font example
    For i = LBound(fontList) To UBound(fontList)
        
        With ActiveDocument.Content.Paragraphs.Add
            
            .Range.Text = MyText & fontList(i) & " font."
            .Range.Font.Name = fontList(i)
            .Range.Font.Size = 12 ' Adjust font size as needed
        
        End With
    
    Next i

End Sub

I'm trying to create a Word document with the same paragraph in all the Word fonts. The macro to do this is printed below. I'm having a problem passing the all the Microsoft Word font names into my variant variable, fontlist. I've used the statement, 'fontList = ActiveDocument.FontNames' but that didn't work'. I've also tried, 'fontList = Application.FontNames' which didn't work either.

So I'd be grateful for any advice and suggestions as to how I can make the following macro work.

My thanks in advance

Sub CreateModernFontExamples()

    Dim fontList As Variant
    Dim i As Integer
    Dim MyText As String
        
    ' Get a list of available fonts
    
    *fontList = Application.FontNames* '***This is the problem statement***
    
    MyText = "The symbol for the English pound is '£'. The quick brown fox jumps over the lazy dog, a classic saying that showcases every letter of the alphabet. If you need a number sequence, try 1234567890, which includes all ten digits. You can even combine them to say, 'The fox leaped over the fence at 3:00 p.m.,' demonstrating both letters and numbers in a single sentence"
    
    ' Create a new paragraph for each font example
    For i = LBound(fontList) To UBound(fontList)
        
        With ActiveDocument.Content.Paragraphs.Add
            
            .Range.Text = MyText & fontList(i) & " font."
            .Range.Font.Name = fontList(i)
            .Range.Font.Size = 12 ' Adjust font size as needed
        
        End With
    
    Next i

End Sub

• vba
• ms-word
• fonts

1 Answer 1

This is hardly anything new. The following macro has been around for decades:

Sub ListFonts()
Application.ScreenUpdating = False
Dim ListFont As Variant
With ActiveDocument.Characters
  For Each ListFont In FontNames
    With .Last
      .Font.Name = "Arial"
      .Font.Size = 12
      .Text = ListFont & Chr(11)
    End With
    With .Last
      .Font.Name = ListFont
      .InsertAfter "ABCDEFGHIJKLMNOPQRSTUVWXYZ ~!@#$%^&*()_+|<>?:{}" & Chr(11) & _
        "abcdefghijklmnopqrstuvwxyz `1234567890-=\,.;'[]" & vbCr
    End With
    With .Last
      .Font.Name = "Arial"
      .InsertAfter vbCr
    End With
  Next ListFont
End With
Application.ScreenUpdating = True
End Sub