#excel #vba #combobox
#excel #vba #combobox
Вопрос:
Моя форма Excel отображает раскрывающийся список (красная стрелка на рисунке) при нажатии на одну из ячеек. Пользователь может начать вводить текст, чтобы запустить функцию автозаполнения, чтобы лучше найти свой выбор. Моя проблема в том, что если пользователь вводит и покидает ячейку, не выбирая из выпадающего списка, все, что он ввел, не покидает ячейку (красный кружок на картинке), и если они не удаляют его, это становится проблемой при экспорте данных.
Я уже пытался изменить стиль со списком на 2, но я получил ошибку 438, объект не поддерживает это свойство.
Код:
Sub Auto_close()
ThisWorkbook.Saved = True
End Sub
Sub Maintenance()
' This macro is a toggle and it's purpose is to prevent/allow the
' autocomplete combobox from being displayed so that Data
' Validation can be maintained if necessary.
gbMaintBeingDone = Not gbMaintBeingDone
End Sub
Public Sub ShowAutocomplete(Target As Range)
Dim strVF As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim strParts() As String
Dim lngIndex As Long
Dim phase_table_arr As Variant
Dim i As Long
Dim colx As Integer, rowx As Integer, row_header As Integer
On Error GoTo errHandler
Set ws = ActiveSheet
If gbMaintBeingDone Then
Exit Sub
End If
Set cboTemp = ws.OLEObjects("TempCombo")
'On Error Resume Next
With cboTemp
' Clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
' The cell contains a data validation list
Application.EnableEvents = False
With cboTemp
' Show the combobox with the list
.Visible = False
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width 15
.Height = Target.Height 5
' Optionally increase the font size
'ActiveSheet.TempCombo.Font.Size = 24
If Not Target.Column = ws.Range("ColumnLast").Column Then
If Left$(Target.Validation.Formula1, 1) <> "=" Then
' The dropdown data is a plain List of values like one,two,three
ActiveSheet.TempCombo.Clear
strParts = Split(Target.Validation.Formula1, ",")
For lngIndex = 0 To UBound(strParts)
ActiveSheet.TempCombo.AddItem strParts(lngIndex)
Next
Else
' The dropdown data comes from a Named Range.
' Get the data validation formula.
strVF = Target.Validation.Formula1
strVF = Right(strVF, Len(strVF) - 1)
.ListFillRange = strVF
End If
.LinkedCell = Target.Address
Else
'Clear listfillrange just in case user selects blank row
.ListFillRange = ""
.LinkedCell = Target.Address
'
End If
End With
cboTemp.Activate
' Open the drop down list automatically
ActiveSheet.TempCombo.DropDown
End If
Application.EnableEvents = True
On Error GoTo 0
Exit Sub
errHandler:
Application.EnableEvents = True
' If it's 1004 there's no data validation in the cell
If Err.Number <> 1004 Then
MsgBox "Error " amp; Err.Number amp; " (" amp; Err.Description amp; ") in procedure ShowAutocomplete"
End If
End Sub
Комментарии:
1. Спасибо, я включил код
2. Просто примечание: если есть ошибка, ваш
On Error ..
не сбрасывается. Возможно, вы захотите включить это в свойerrHanlder
код3. @Zac, должен ли я включить «Возобновить следующий» после окончания, если в моем обработчике ошибок? Или я мог бы вставить ‘Err.Clear ()’ перед выходом из Sub? Я очень новичок в VBA
4. Почему бы не использовать
Private Sub Worksheet_Change
илиPrivate Sub Worksheet_SelectionChange
, чтобы проверить, находится ли данноеTarget
в вашем столбце и не хватает ли в нем правильных вторых данных?