Font names alphabetically

[Peter Lux]

I'm looking to get a list of the font names ALPHABETICALLY, instead of the
order in which they were installed. For example:
i = FontNames.Count()
n = 1
While n <= i
Selection.Font.Name = FontNames(n)
Selection.Font.Size = 12
Selection.TypeText FontNames(n) & Str(n) & "Jackdaws love my big
sphinx of quartz !_-*()" & vbCr
n = n + 1
Wend

FontNames gathers all the fonts, but doesn't do it in Alphabetical order.
Does anyone know how to get that?

 

[Greg Maxey]

Peter,

Using brute force you could do it like this:
Sub Test()
Dim i As Long
Dim n As Long
i = FontNames.Count()
n = 1
While n <= i
Selection.Font.Name = FontNames(n)
Selection.Font.Size = 12
Selection.TypeText " " & vbTab & FontNames(n) & vbTab &
"Jackdaws ..." & vbCr
n = n + 1
Wend
ActiveDocument.Range.ConvertToTable Separator:=vbTab
ActiveDocument.Tables(1).Sort FieldNumber:=2
For i = n To 1 Step -1
ActiveDocument.Tables(1).Cell(i, 1).Range.Text = i
Next
ActiveDocument.Tables(1).ConvertToText Separator:=vbTab
End Sub

 

[Greg Maxey]

Faster and with a little less force '-)

Sub ListFontsAlphabetically()
Dim i As Long
Dim oRng As Word.Range
Dim myArray() As String
ReDim myArray(FontNames.Count - 1)
For i = 1 To FontNames.Count
myArray(i - 1) = FontNames(i)
Next i
WordBasic.sortarray myArray
For i = 0 To UBound(myArray)
Set oRng = ActiveDocument.Range
With oRng
.Start = oRng.End - 1
.Font.Name = FontNames(i + 1)
.Font.Size = 12
.InsertAfter i + 1 & ". " & myArray(i) & " Jackdaws ..." & vbCr
End With
Next i
End Sub

 

[Karl E. Peterson]

I'm looking to get a list of [whatever] ALPHABETICALLY, instead of the order in
which they were [provided].

The approach *programmers* most often take to this very common scenario is to read
the supplied values into an array, then sort the array as desired.

 

[Peter Lux]

Faster and with a little less force '-)

Sub ListFontsAlphabetically()
Dim i As Long
Dim oRng As Word.Range
Dim myArray() As String
ReDim myArray(FontNames.Count - 1)
For i = 1 To FontNames.Count
myArray(i - 1) = FontNames(i)
Next i
WordBasic.sortarray myArray
For i = 0 To UBound(myArray)
Set oRng = ActiveDocument.Range
With oRng
.Start = oRng.End - 1
.Font.Name = FontNames(i + 1)
.Font.Size = 12
.InsertAfter i + 1 & ". " & myArray(i) & " Jackdaws ..." & vbCr
End With
Next i
End Sub

Greg - Thanks a million!
I think though, it should read
.Font.Name = myArray(i+1)
instead of
.Font.Name = FontNames(i+1)

Otherwise you get an alphabetic listing, but the font listed isn't the font
shown.

 

[Greg Maxey]

Peter,

Goes to show how much I know about fonts ;-)

Actually it should be:
..Font.Name = myArray(i)

here the + 1 generates an error.