VBA – Show all available fonts in MS Word

Posted on October 25, 2014 by

We know that VBA is also available in MS Word. Very few people use it, and they do it for a reason. Whenever you say that you are an Excel programmer, the “Hard Core” programmers kindly laugh at you and thus I cannot imagine what would happen, if you state you are a MS Word programmer.

Anyway, it is possible to program in MS Word and it is even more difficult to find a job as a MS Word programmer than it is with any other programming language! 100% sure 😉

In the current example I will show you a code, that shows all the available fonts you have in MS Word and writes them on a word document. Quite a useful thing, if you want to check all the fonts and you do not like the idea of the Word dropdown menu. Anyway, this is what we do with the code:

We generate a table in the active document with 4 columns.
We write on the table “Font Name” and “Example” twice.
We simply write in two columns all the fonts we have, using a boolean variable, telling us whether we should write in the left column or in the right one. If we write in the right one, we need to add a new row.
Pretty much that is it – the for each loop does it all!

Here is the code! Enjoy it with care 🙂

Sub <span class="hiddenSpellError">ShowAllFonts</span>()

    Dim <span class="hiddenSpellError">vFont</span>           As Variant
    Dim <span class="hiddenSpellError">oTable</span>          As Table
    Dim <span class="hiddenSpellError">oRow</span>            As Row
    Dim <span class="hiddenSpellError">bLeft</span>           As Boolean
    
    Set <span class="hiddenSpellError">oTable</span> = ActiveDocument.Tables.Add( _
                    Range:=Selection.Range, _
                    <span class="hiddenSpellError">NumRows</span>:=1, _
                    <span class="hiddenSpellError">NumColumns</span>:=4)
    We
    Set <span class="hiddenSpellError">oRow</span> = oTable.Rows.Add
    oTable.Rows(1).Cells(1).Range.Text = "Font Name"
    oTable.Rows(1).Cells(2).Range.Text = "Example"
    oTable.Rows(1).Cells(3).Range.Text = "Font Name"
    oTable.Rows(1).Cells(4).Range.Text = "Example"
    oTable.Rows(1).Select
    oTable.Rows.Add
    Selection.Font.Underline = wdUnderlineSingle
    
    Set <span class="hiddenSpellError">oRow</span> = oTable.Rows.Last
    <span class="hiddenSpellError">bLeft</span> = True
    
    For Each <span class="hiddenSpellError">vFont</span> In <span class="hiddenSpellError">FontNames</span>
        
        With oTable.Rows.Last
        If (<span class="hiddenSpellError">bLeft</span>) Then
            .Cells(1).Range.Text = <span class="hiddenSpellError">vFont</span>
            .Cells(2).Range.Text = vFont
            .Cells(1).Range.Font.Name = vFont
            <span class="hiddenSpellError">bLeft</span> = Not <span class="hiddenSpellError">bLeft</span>
            
        Else
        <span class="hiddenSpellError">wri</span>
            .Cells(3).Range.Text = vFont
            .Cells(4).Range.Text = vFont
            .Cells(3).Range.Font.Name = vFont
            <span class="hiddenSpellError">bLeft</span> = Not <span class="hiddenSpellError">bLeft</span>
        End If
        End With
        
        If (<span class="hiddenSpellError">bLeft</span>) Then
            Set <span class="hiddenSpellError">oRow</span> = oTable.Rows.Add
        End If
    
    Next vFont

End Sub

Sub ShowAllFonts()

Dim vFont As Variant

Dim oTable As Table

Dim oRow As Row

Dim bLeft As Boolean

Set oTable = ActiveDocument.Tables.Add( _

Range:=Selection.Range, _

NumRows:=1, _

NumColumns:=4)

Set oRow = oTable.Rows.Add

oTable.Rows(1).Cells(1).Range.Text = "Font Name"

oTable.Rows(1).Cells(2).Range.Text = "Example"

oTable.Rows(1).Cells(3).Range.Text = "Font Name"

oTable.Rows(1).Cells(4).Range.Text = "Example"

oTable.Rows(1).Select

oTable.Rows.Add

Selection.Font.Underline = wdUnderlineSingle

Set oRow = oTable.Rows.Last

bLeft = True

For Each vFont In FontNames

With oTable.Rows.Last

If (bLeft) Then

.Cells(1).Range.Text = vFont

.Cells(2).Range.Text = vFont

.Cells(1).Range.Font.Name = vFont

bLeft = Not bLeft

Else

wri

.Cells(3).Range.Text = vFont

.Cells(4).Range.Text = vFont

.Cells(3).Range.Font.Name = vFont

bLeft = Not bLeft

End If

End With

If (bLeft) Then

Set oRow = oTable.Rows.Add

End If

Next vFont

End Sub

🙂