Microsoft Office Forums - View Single Post - [Solved] Need Help Modifying Code to print all fonts

Guessed · 11-10-2021, 07:17 PM

I prefer to load this type of information to a table so it can be sorted and formatted more easily. Try this variation on the code.

Code:

Sub InsertAllFontSamples()
  'Inserts samples of all installed fonts into the current file
  Dim strFont As Variant, sText As String, oTbl As Table, aRng As Range, oRow As Row
  sText = "The quick brown fox jumped over the lazy dog. 12345 67890"
  Application.ScreenUpdating = False
    Set aRng = Selection.Range
    Set oTbl = ActiveDocument.Tables.Add(Range:=aRng, numrows:=1, numcolumns:=2)
    oTbl.cell(1, 1).Range.Text = "Font"
    oTbl.cell(1, 2).Range.Text = "Sample"
    oTbl.Range.Style = wdStyleNormal
    oTbl.Columns(1).PreferredWidthType = wdPreferredWidthPercent
    oTbl.Columns(1).PreferredWidth = 30
    oTbl.Columns(2).PreferredWidth = 70
    For Each strFont In Application.FontNames
      Set oRow = oTbl.Rows.Add
      oRow.Cells(1).Range.Text = strFont
      oRow.Cells(2).Range.Text = sText
      oRow.Cells(2).Range.Font.Name = strFont
    Next strFont
    oTbl.ApplyStyleHeadingRows = True
    oTbl.SortAscending
  Application.ScreenUpdating = True
  MsgBox "Macro finished!"
End Sub