代码之家  ›  专栏  ›  技术社区  ›  Przemyslaw Remin

什么vba事件允许捕获ActiveX组合框的单击值?

  •  0
  • Przemyslaw Remin  · 技术社区  · 5 年前

    通过鼠标单击从ActiveX组合框中选择项后,我希望关闭组合框并选择项。

    下面是一个例子。

    enter image description here

    我试过了 TempCombo_Click 但在 TempCombo_Change 事件。当我通过单击选择项目时,我的搜索字符串传递给 温度组合变化 事件为空。所以我需要一些东西来保存项目选择 温度组合变化 事件。

    我使用修改的vba代码取自 Autocomplete suggestion in Excel data validation list again

    下面是我用来生成上述示例的vba精确代码。

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim xCombox As OLEObject
        Dim xStr As String
        Dim xWs As Worksheet
        Dim xArr
        Set xWs = Application.ActiveSheet
        On Error Resume Next
        Set xCombox = xWs.OLEObjects("TempCombo")
        With xCombox
            .ListFillRange = ""
            .LinkedCell = ""
            .Visible = False
        End With
        If Target.Validation.Type = 3 Then
            Target.Validation.InCellDropdown = False
            'Cancel = True
            xStr = Target.Validation.Formula1
            xStr = Right(xStr, Len(xStr) - 1)
            If xStr = "" Then Exit Sub
            With xCombox
                .Visible = True
                .Left = Target.Left
                .Top = Target.Top
                .Width = Target.Width + 5
                .Height = Target.Height + 5
                .ListFillRange = xStr
                If .ListFillRange = "" Then
                    xArr = Split(xStr, Application.International(xlListSeparator))
                    Me.TempCombo.List = xArr
                End If
                .LinkedCell = Target.Address
            End With
            xCombox.Activate
            Me.TempCombo.DropDown
        End If
    End Sub
    
    Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        Select Case KeyCode
            Case 9 'tab
                Application.ActiveCell.Offset(0, 1).Activate
            Case 13 'enter
                Application.ActiveCell.Offset(1, 0).Activate
        End Select
    End Sub
    
    Private Sub TempCombo_Change()
    If Me.TempCombo = "" Then Exit Sub
    ActiveSheet.OLEObjects(1).ListFillRange = ""
    ActiveSheet.OLEObjects("TempCombo").Object.Clear
    ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Activate
    
    With Me.TempCombo
        If Not .Visible Then Exit Sub
        .Visible = False 'to refresh the drop down
        .Visible = True
        .Activate
    
    'Dump the range into a 2D array
            Dim Arr2D As Variant
            Arr2D = [RangeItems].Value
    
    'Declare and resize the 1D array
            Dim Arr1D As Variant
            ReDim Arr1D(1 To UBound(Arr2D, 1))
    
    'Convert 2D to 1D
            Dim i As Integer
            For i = 1 To UBound(Arr2D, 1)
                Arr1D(i) = Arr2D(i, 1)
            Next
    
        Dim itm As Variant 'itm is for iterate purpose
        Dim ShortItemList() As Variant 'ShortItemList() is a variable which stores only filtered items
        i = -1
        For Each itm In Arr1D
            If InStr(1, itm, .Value, vbTextCompare) > 0 Or .Value = "" Then
                Debug.Print itm
                 i = i + 1
                 ReDim Preserve ShortItemList(i)
                 ShortItemList(i) = itm
            End If
        Next itm
        .DropDown
    End With
    
    On Error Resume Next 'if we filter too much, there will be no items on ShortItemList
    ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Object.List = ShortItemList
    
    End Sub
    
    1 回复  |  直到 5 年前
        1
  •  0
  •   Przemyslaw Remin    5 年前

    这条线在 TempCombo_Click 事件解决了问题:

    ActiveCell.Value = ThisWorkbook.ActiveSheet.OLEObjects("TempCombo").Object.Value