使用VBA中已存在的选项填充下拉框？

Question

我为我的电子表格制作了一个添加记录表单，让我们说我希望其中一个控件成为一个下拉列表，该下拉列表由某列下的唯一条目填充＆＃34 ;类型＆＃34 ;.但是，我还想让Dropbox始终有一个初始选项来添加新类型＆＃34;经过这样的选择，它就变成了一个普通的文本框。我将如何在VBA中执行此操作？

Answer 1

您无法在运行时更改控件类型。最简单的方法是创建一个组合框和一个文本框。将文本框可见性设置为false。然后在组合框的onchange事件中，您的代码将取消隐藏文本框并隐藏组合框。您还需要一个保存按钮，以便在单击时将其添加到下拉菜单中，清除文本框，隐藏文本框，隐藏按钮并取消隐藏下拉菜单。

Answer 2

好的，所以我的想法是如何解决这个问题。

1. 创建2个隐藏元素（Visibility = False），一个是TextBox，另一个是CommandButton。
2. 使用“type”
列下的工作表中的值填充您的ComboBox
3. 添加一个条目AddItem，其中包含“添加新项目...”
等字词
4. 当用户选择“添加新项目...”时，更改TextBox＆amp;的可见性。 CommandButtons为True
5. 当用户单击CommandButton时，将该短语添加到该列并向ComboBox添加新元素

我创建了一个模型UserForm和代码，它不仅仅是这个;它还将用户条目设置为句子大小写（一致性目的），并检查以确保该值不在列中。

带有“类型”列的Excel工作表



带有名称标签的用户窗口



UserForm代码

Private Sub bAdd_Click()
Dim str As String
Dim rng As Range
Dim ro As Integer
    'Makes sure there is an entry, adds it to the Sheet and then updates the dropdown
    If Len(Me.tbNew) > 0 Then
        'Converts user entry to "Sentance Case" for better readability
        str = StrConv(Me.tbNew, vbProperCase)

        'Finds out if the entry already exists
        Set rng = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1))
        On Error Resume Next
        Err.Number = 0
        'Searches for duplicate; if found, then ListIndex of cbColor is modified without inserting new value (prevents duplicates)
        ro = rng.Find(str, LookIn:=xlValues, LookAt:=xlWhole).Row
        Debug.Print Err.Number
        'Ensures a user doesn't add the same value twice
        If Err.Number > 0 Then
            Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row + 1, 1) = str
            Me.cbColor.AddItem StrConv(Me.tbNew, vbProperCase), Me.cbColor.ListCount - 1
            Me.cbColor.ListIndex = Me.cbColor.ListCount - 2
        Else
            Me.cbColor.ListIndex = ro - 2
        End If
        'Resets and hides user form entries
        Me.tbNew = vbNullString
        Me.tbNew.Visible = False
        Me.bAdd.Visible = False
    End If
End Sub

Private Sub bClose_Click()
    Unload Me
End Sub

Private Sub cbColor_Change()
    'Visibility is toggled based on if the user selected the last element in the dropdown
    Me.bAdd.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
    Me.tbNew.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
End Sub

Private Sub UserForm_Initialize()
    'Populate from the sheet
    For a = 2 To Sheets(1).Cells(Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1).Row
        Me.cbColor.AddItem Sheets(1).Cells(a, 1)
    Next
    'Add option for new type
    Me.cbColor.AddItem "Add new type..."
End Sub