All Font Preview Microsoft Word Macro

Sub Generate_Font_Preview()
Dim doc As Word.Document
Dim objRange As Range
Dim oTable  As Word.Table
Dim iCnt  As Integer
Dim s1 As Range
Dim str As String

Set doc = Application.Documents.Add
Set objRange = doc.Range()
str = InputBox("Please enter Preview Text", "Preview Text")

doc.Tables.Add objRange, Application.FontNames.Count, 2
Set oTable = doc.Tables(1)


For iCnt = 1 To FontNames.Count
    If (IsEmpty(str)) Then
        str = Application.FontNames(iCnt)
    End If
    oTable.Cell(iCnt, 1).Range.Text = Application.FontNames(iCnt)
    oTable.Cell(iCnt, 1).SetWidth ColumnWidth:=InchesToPoints(1.5), RulerStyle:=wdAdjustSameWidth
    With oTable.Cell(iCnt, 2).Range
        .Text = str
        .Font.Name = Application.FontNames(iCnt)
        .Font.Size = 25
        .Font.Color = WdColor.wdColorBlack
    End With
Next iCnt
End Sub