Populate Combobox with font names - excel

Question

I want to populate a combobox on a userform with available fonts on a pc, when the userform is initialized. i have written a code for it, but it just gives me an error:
Run-time error '-2147467259 (80004005)':
Method 'ListCount' of Object '_CommanBarComboBox' failed
Ive tried to modify the i = 1 to i = 0, but it doesnt helped me.
Private Sub UserForm_Initialize()
Image3.Visible = False
Image6.Visible = False
Dim FontList
Dim i
CreatePapers.ComboBox1.Clear
Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
For i = 1 To FontList.ListCount
CreatePapers.ComboBox1.AddItem FontList.List(i + 1)
Next i
End Sub
EDIT:
I modified the code, the error is gone, however, nothing is filled into the combobox.
Dim FontList As CommandBarControl
Dim i As Long
Dim Tempbar As CommandBar
CreatePapers.ComboBox1.Clear
On Error Resume Next
Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
' If Font control is missing, create a temp CommandBar
If FontList Is Nothing Then
Set Tempbar = Application.CommandBars.Add
Set FontList = Tempbar.Controls.Add(ID:=1728)
End If
For i = 1 To FontList.ListCount
Debug.Print FontList.List(i)
CreatePapers.ComboBox1.AddItem FontList.List(i)
Next i
Me.ComboBox1.ListIndex = 0
' Delete temp CommandBar if it exists
On Error Resume Next
Tempbar.Delete
EDIT 2:
Added 2 lines of code into the above modified code as mentioned by T.M. , but it still doesnt fill up the combobox, its just empty.
EDIT 3:
Changed some line in the code, but still it doesnt retrieves the fonts. Also the FontList is empty, even after the If FontList Is Nothing Then part, where it creates the temporary control bar.

Answer 1

You could shorten initializing into a more readable form by assigning a complete array to the combobox'es .List property:
Private Sub UserForm_Initialize()
Me.ComboBox1.List = GetFontList() ' << calling `GetFontList()
End Sub
The array itself is the result of the following function:
Option Explicit
Function GetFontList() As Variant
Dim FontList As CommandBarControl ' << declare type
On Error Resume Next ' provide for missing font control
Set FontList = Application.CommandBars("Formatting").FindControl(id:=1728)
On Error GoTo 0
'If Font control is missing, create it on a temporary CommandBar
If FontList Is Nothing Then
Dim tmpBar As CommandBar
Set tmpBar = Application.CommandBars.Add
Set FontList = tmpBar.Controls.Add(id:=1728)
End If
Dim tmpList: ReDim tmpList(1 To FontList.ListCount, 1 To 1)
'Assign fonts to array
Dim i As Long
For i = 1 To UBound(tmpList)
tmpList(i, 1) = FontList.List(i)
Next i
'Delete temporary CommandBar eventually
On Error Resume Next
tmpBar.Delete
'return 2-dim 1-based font array as function result
GetFontList = tmpList
End Function
Further hints
The CommandBarControl items can be addressed by a one-based index via
FontList.List(i)
*) The combobox'es 2-dimensional .List property is zero-based, but accepts also assignment of a one-based array (as returned by above function).

Answer 2

You are accessing a FontList item that does not exist. Your for-loop is fine. But, you need to change the line inside to:
CreatePapers.ComboBox1.AddItem FontList.List(i)
Accessing index + 1 is reaching outside of the bounds of the list, this is why it's crashing.
Your code should look like:
Private Sub UserForm_Initialize()
Image3.Visible = False
Image6.Visible = False
Dim FontList
Dim i
CreatePapers.ComboBox1.Clear
Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728)
For i = 1 To FontList.ListCount
CreatePapers.ComboBox1.AddItem FontList.List(i)
Next i
End Sub