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