|
Dim J As Integer
Dim FontTable As Table
'Start off with a new document
Set NewDoc = Documents.Add
'Add a table and set the table header
Set FontTable =
NewDoc.Tables.Add(Selection.Range, FontNames.Count + 1, 2)
With FontTable
.Borders.Enable = False
.Cell(1, 1).Range.Font.Name = "Arial"
.Cell(1, 1).Range.Font.Bold = 1
.Cell(1, 1).Range.InsertAfter "Font Name"
.Cell(1, 2).Range.Font.Bold = 1
.Cell(1, 2).Range.InsertAfter "Font Example"
End With
'Go through all the fonts and add them to the
table
For J = 1 To FontNames.Count
With FontTable
.Cell(J + 1, 1).Range.Font.Name =
"Arial"
.Cell(J + 1, 1).Range.Font.Size = 10
.Cell(J + 1, 1).Range.InsertAfter
FontNames(J)
.Cell(J + 1, 2).Range.Font.Name =
FontNames(J)
.Cell(J + 1, 2).Range.Font.Size = 10
.Cell(J + 1, 2).Range.InsertAfter "ABCDEFG
abcdefg 1234567890"
End With
Next J
FontTable.Sort SortOrder:=wdSortOrderAscending
|
