工作表更改事件上的 Excel VBA 组合框

Question

我正在 Excel 工作表上动态创建一组组合框，但我只想要一个通用的“操作”方法。我从一个工作表中获取数据以填充主工作表上的组合

我的代码如下，但是当事件触发（它确实触发）时，我无法访问每个单独的组合框。有没有办法知道哪个组合框被触发了？即使只是索引、名称或其他东西，我也可以去查找相关的组合框。 （combo 的总数将是 200，而 Form 不是我们想要的，因为其他原因，这就是为什么它在一张表中。）

Option Explicit

Dim i As Integer
' This is used to programme the comboboxes
Private Sub GenerateComboboxes()

    On Error GoTo ErrorHandler

    Dim DestinationDataTypeCombo As Object, DestinationDataTextCombo As Object, oObject As Object
    Dim ws As Worksheet, sString As String, rng As Range
    
    Dim nCombos, nStartLine As Integer
    Dim i2, iHeight, iLeft, iTop, iWidth As Integer
    
    nCombos = 5
    nStartLine = 2
    
    Set ws = Worksheets("User Entry")
    ws.Activate
    
    'Clear what was there before
    For Each oObject In ws.Shapes
        oObject.Delete
    Next
    
    ' add each combo to the worksheet
    For i = 0 To nCombos - 1
        sString = "D" & (i + nStartLine)
        Set rng = ws.Range(sString)
        
        ' Create a Combo instance
        Set DestinationDataTypeCombo = ws.Shapes.AddFormControl(xlDropDown, _
                                      Left:=rng.Left, _
                                      Top:=rng.Top, _
                                      Width:=rng.Width, _
                                      Height:=rng.Height)
                                      
        ' Set up the properties
        With DestinationDataTypeCombo
            .ControlFormat.DropDownLines = 5
            .Name = "cbDataType" & i
            For i2 = 2 To 17
                sString = Worksheets("Static Data").Cells(i2, 1)
               .ControlFormat.AddItem sString
                
            Next
            ' Set a generic OnAction for ALL combos to use
            .OnAction = "cbDataType_Change"
        End With
       
    Next i
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description
     
End Sub
Public Sub cbDataType_Change()

    On Error GoTo ErrorHandler
    
    Dim sValue As String
    'This works so I know the change event fires
    MsgBox "Test"
    ' Want to get the value selected, this line errors
    sValue = cbDataType.Value
    MsgBox sValue
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description
     
End Sub

Answer 1

您的代码会创建一个表单下拉组合框。表单控件类型不公开任何事件...

您可以使用.OnAction 为它分配一个宏，命名为您想要的任何名称（甚至是cbDataType_Change）。

现在，可以从Application.Caller 开始返回使用的对象，它返回控件名称。基于它，可以设置控制对象，使用Sheet.Shapes。最后，可以使用对象OLEFormat.Object.list 以更复杂的方式检索此类控件的值。所以，分配给所有控件的Sub 应该是这样的：

Sub cbDataType_Change() 'this is not an event!
    Dim cb As Object
    
    Set cb = ActiveSheet.Shapes(Application.Caller) 'the object which called this Sub
    Debug.Print cb.Name, cb.ControlFormat.Value     'returns the control name and its index
    MsgBox cb.OLEFormat.Object.list(cb.ControlFormat.Value) 'the control value
End Sub