Я хочу создать выпадающий список в ячейке, которую нажимает пользователь, и разрешить пользователю писать и / или выбирать (автозаполнение, аналогичное google), установить его в ячейку и закрыть выпадающий список.
У меня есть этот код, который создает окно:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lst
If Not Intersect([4:7], Target) Is Nothing And Target.Count = 1 Then
Me.DropDowns.Delete
With Worksheets("Listing")
lst = "'" & .Name & "'!" & _
.Range(.Range("a1"), _
.Cells(.Rows.Count, 1).End(xlUp)).Address()
End With
With Me.Shapes.AddFormControl(xlDropDown, Left:=Target.Left, _
Top:=Target.Top, Width:=60, Height:=15)
.Name = "CB"
.OnAction = "CB_Change"
.ControlFormat.ListFillRange = lst
End With
End If
End Sub
Проблема в том, что созданные списки позволяют пользователю выбирать, а не писать в
2 ответа
Элементы управления ActiveX легче настраивать, чем элементы управления формы. Элементы управления MSForm.ComboBox имеют свойство Style, которое при значении fmStyleDropDownCombo делает область текстового поля редактируемой; когда стиль fmStyleDropDownList, пользовательский ввод ограничен тем, что находится в раскрывающемся списке.
... с учетом сказанного, Проверка данных , вероятно, является лучшим вариантом (менее подверженным ошибкам , лучше интегрированный с рабочим листом / Excel, без зависимости MSForm), если вы можете жить с «кружком недопустимых данных», делая красные кружки вокруг «недопустимых данных», которые разрешено вводить, но не в раскрывающемся списке:
Если возможно, используйте вместо этого проверку данных. Это создаст доступный для записи комбо, основанный на значениях в ячейках J3: J5
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([4:7], Target) Is Nothing And Target.Count = 1 Then
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$J$3:$J$5"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
' This will expand the list
Target.Select
SendKeys "%{DOWN}"
End If
End Sub