用字体名称填充组合框

问题描述

初始化用户窗体时,我想用PC上的可用字体填充用户窗体上的组合框。我已经为此编写了代码,但是它只是给我一个错误

Run-time error '-2147467259 (80004005)':
Method 'ListCount' of Object '_CommanBarComboBox' Failed

我试图将i = 1修改为i = 0,但这并没有帮助我。

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

编辑:

修改代码错误消失了,但是,组合框中没有任何内容

 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

编辑2: 如T.M.所述,在上述修改后的代码添加了2行代码。 ,但它仍然没有填满组合框,只是空白。

编辑3: 更改了代码中的某些行,但仍然不检索字体。同样,即使在If FontList Is nothing Then部分之后,FontList也为空,它在其中创建了临时控制栏。

解决方法

您正在访问一个不存在的FontList项目。您的for-loop很好。但是,您需要将内部的行更改为:

CreatePapers.ComboBox1.AddItem FontList.List(i)

正在访问索引+ 1超出列表范围,这就是为什么它崩溃的原因。

您的代码应如下所示:

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
,

您可以通过将完整的数组分配给组合框的 System.out.println(); boolean willReachEqual = (num1 <= num2) && (num2 <= 100); boolean willReachHalf = (num1 * 2 <= num2) && ((num2 % 2) == 0) && (num2 <= 200); boolean willReachBoth = willReachEqual && willReachHalf; System.out.println( (willReachHalf ? (num2 / 2) : "") + (willReachBoth ? "," : "") + (willReachEqual ? num2 : "")); 属性来缩短初始化为更易读的形式:

.List

数组本身是以下函数的结果:

Private Sub UserForm_Initialize()
    Me.ComboBox1.List = GetFontList()    ' << calling `GetFontList()  
End Sub

其他提示

CommandBarControl项可以通过基于一个的索引通过

来寻址
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

*)组合框的二维FontList.List(i) 属性基于,但也接受基于一个的数组的分配(由上述函数返回)。