Как я могу изменить раскрывающийся список проверки данных VBA, чтобы запретить пользовательский ввод?

#excel #vba #combobox

#excel #vba #combobox

Вопрос:

Моя форма Excel отображает раскрывающийся список (красная стрелка на рисунке) при нажатии на одну из ячеек. Пользователь может начать вводить текст, чтобы запустить функцию автозаполнения, чтобы лучше найти свой выбор. Моя проблема в том, что если пользователь вводит и покидает ячейку, не выбирая из выпадающего списка, все, что он ввел, не покидает ячейку (красный кружок на картинке), и если они не удаляют его, это становится проблемой при экспорте данных.

Я уже пытался изменить стиль со списком на 2, но я получил ошибку 438, объект не поддерживает это свойство.

Скриншот Excel

Скриншот кода 1

Скриншот кода 2

Код:

 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 в вашем столбце и не хватает ли в нем правильных вторых данных?