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

我正在为我的电子表格添加一个logging表单，假设我希望其中一个控件是一个下拉列表，这个下拉列表由某个“type”列下的唯一条目填充。 不过，我也希望Dropbox总是有一个“添加新types”的初始选项，在这样的select下，它就变成了一个常规的文本框。 我如何在VBA中做到这一点？

Answer 1

您不能在运行时更改控件types。 最简单的做法是创build一个combobox和一个文本框。 将文本框可见性设置为false。 然后在combobox的onchange事件中，您的代码将取消隐藏文本框并隐藏combobox。 您还需要一个保存button，这样当它被点击时，它会将该选项添加到下拉菜单中，清除文本框，隐藏文本框，隐藏button并取消隐藏下拉菜单。

Answer 2

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

1. 创build2个隐藏的元素（可见性= False），一个文本框和一个CommandButton。
2. 使用“type”列下的表格中的值填充ComboBox
3. 添加一个项目AddItem与措辞，如“添加新项目…”
4. 当用户select“添加新项目…”时，将TextBox＆CommandButtons的可见性更改为True
5. 当用户单击CommandButton时，将该短语添加到列，并添加一个新的元素到combobox

我创build了一个模型用户窗体和代码，比这更多一点， 它还将用户条目设置为句子（一致性目的）并检查以确保该值不在列中。

带有“types”列的Excel工作表

用户窗体与名称标签

用户窗体代码

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