View Single Post
 
Old 02-26-2021, 04:52 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

How are you adding the names to the listbox.

Try the following which adds all the font names to the list box ListBox1. On my PC the count is 660 fonts.

Code:
Private Sub UserForm_Initialize()
Dim arrFonts As Variant
Dim lng_Index As Long
    With ListBox1
        .Clear
        ReDim arrFonts(Application.FontNames.Count - 1)
        For lng_Index = 0 To Application.FontNames.Count - 1
            arrFonts(lng_Index) = Application.FontNames(lng_Index + 1)
        Next lng_Index
        SortArray arrFonts
        .List = arrFonts
        MsgBox .ListCount
    End With
End Sub

Private Function SortArray(Arr As Variant) As Variant
Dim i As Long
Dim j As Long
Dim Temp As Variant
    For i = LBound(Arr) To UBound(Arr) - 1
        For j = i + 1 To UBound(Arr)
            If UCase(Arr(i)) > UCase(Arr(j)) Then
                Temp = Arr(j)
                Arr(j) = Arr(i)
                Arr(i) = Temp
            End If
        Next j
    Next i
    SortArray = Arr
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote