Question

目标：创建一个类来包装Form控件，并在单击时将控件名称传递给公共回调。

我尝试通过UserForm Worksheet访问Shapes上的Collection个控件。 Shape对象有一个名为OLEFormat的属性，该属性又具有Object属性，其Type反映了MSForms属性（例如OptionButton）。这是我可以找到访问工作表上的表单控件的唯一方法。

mShape.OLEFormat.Object

当我尝试将本地MSForms对象（例如MSForms.OptionButton）设置为mShape.OLEFormat.Object时，VBA运行时会抛出Type Missmatch错误。

这是一个怪癖还是有逻辑推理的原因？无论哪种方式，我该如何解决这个问题？我认为我可以通过将Class中的本地控制声明为Variant来实现它，但我很想知道是否有更合理的方式......

自定义类：

'Custom Class ceFormControlsTest
Option Explicit
Private WithEvents mobtOption As MSForms.OptionButton
Public Name As String
Public controlType As String
Private mShape As Shape

Property Get Shape() As Shape
    Set Shape = mShape
End Property
Public Property Let Shape(obNew As Shape)
    controlType = TypeName(obNew.OLEFormat.Object)
    Select Case controlType
    Case "OptionButton"
'/////////Fails here Run  Time Error 13: Type Missmatch////////
        Set mobtOption = obNew.OLEFormat.Object
'//////////////////////////////////////////////////////////////
    Case Else
    End Select
    Name = obNew.Name
End Property


Private Sub mobtOption_Click()
    Call DoWithControl(Name)
End Sub

测试代码：

'//////////////////////////////////////////////////////////////////////////////////////
'In a Standard Module

Option Explicit
Public mcolEvents As Collection

Public Sub InitializeFormControls()
' Loop through Form Controls on a Worksheet, wrap them in a Custom Class and Add them to a Collection.

Dim mShape As Shape
Dim osh As Worksheet
Dim mMSG As String
'Wrapper...
Dim mControl As ceFormControlsTest

    Set osh = ActiveSheet
'   Manage the Collection
    If mcolEvents Is Nothing Then
        Set mcolEvents = New Collection
    End If
'   Access the Controls via their Shape Wrappers, wrap them with events and add to the Collection
    For Each mShape In osh.Shapes
        Set mControl = New ceFormControlsTest
        mControl.Shape = mShape
        mcolEvents.Add mControl, mControl.Name
    Next

'   Show the members of the collection
    mMSG = "Shape Name" & vbTab & "OLEType" & vbTab & "controlType" & vbCrLf
    For Each mControl In mcolEvents
        With mControl
            mMSG = mMSG & .Name & vbTab & .Shape.OLEFormat.Object.OLEType & vbTab & .controlType & vbCrLf
        End With
    Next mControl
    MsgBox mMSG

End Sub

Answer 1

原因是这两个控件属于不同类型，不能相互分配。这是放置在工作表上的两个OptionButtons的示例。首先是Form-Control，其次是ActiveX-Control。

enter image description here

Sub test()
    Dim formOptionButton As Variant
    Set formOptionButton = ActiveSheet.Shapes(1).OLEFormat.Object
    Debug.Print "TypeName of formOptionButton is " & TypeName(formOptionButton)

    Dim activeXControlButton As Variant
    Set activeXControlButton = ActiveSheet.OLEObjects(1).Object
    Debug.Print "TypeName of activeXControlButton is " & TypeName(activeXControlButton); ""

    Debug.Print "... but:"

    If TypeOf activeXControlButton Is MSForms.OptionButton Then
        Debug.Print "activeXControlButton is MSForms.OptionButton"
    Else
        Debug.Print "activeXControlButton is not MSForms.OptionButton"
    End If

    If TypeOf formOptionButton Is MSForms.OptionButton Then
        Debug.Print "formOptionButton is MSForms.OptionButton"
    Else
        Debug.Print "formOptionButton is not MSForms.OptionButton"
    End If
End Sub

Output:
TypeName of formOptionButton is OptionButton
TypeName of activeXControlButton is OptionButton
... but:
activeXControlButton is MSForms.OptionButton
formOptionButton is not MSForms.OptionButton

如果在工作表上使用MSForm.OptionButton而不是Form-OptionButton，则可以解决此问题。

有关表单和ActiveX控件以及何时使用的更多信息，请查看此处： Overview of forms, Form controls, and ActiveX controls on a worksheet

HTH。

Answer 2

感谢@dee和@Rory的指导，我提出了以下解决方案：

要点

将常用回调放入Form Control的onAction宏
使用Application.Caller获取控件名称

自定义类：

'Custom Class clseFormControls
Option Explicit
Const callBack As String = "DoWithFormControl"
Const controlTypes As String = "CheckBox" & "OptionButton" & "Label" & "ScrollBar" & "ListBox" & "Spinner" & "DropDown"

Private WithEvents mobtOption As MSForms.OptionButton
Private vControl As Variant
Public Name As String
Public controlType As String
Private mShape As Shape

Property Get Shape() As Shape
    Set Shape = mShape
End Property
Public Property Let Shape(pSh As Shape)
    With pSh.OLEFormat
        controlType = TypeName(.Object)
        If controlType <> "OLEObject" And InStr(controlTypes, controlType) <> 0 Then
            Set vControl = .Object
            vControl.OnAction = callBack
        Else
            vControl = Empty
        End If
        Name = .Object.Name
    End With 'pSh.OLEFormat
    Set mShape = pSh
End Property

测试代码：

'In a Standard Module
Option Explicit
Public mcolFormEvents As Collection
Public Sub InitializeFormControls()
' Loop through Form Controls on a Worksheet, wrap them in a Custom Class and Add them to a Collection.
Const col1 As Long = 30
Dim mShape As Shape
Dim osh As Worksheet
Dim mMSG As String
'Wrapper...
Dim mControl As clseFormControls

    Set osh = ActiveSheet
'   Manage the Collection
    If mcolFormEvents Is Nothing Then
        Set mcolFormEvents = New Collection
    End If
'   Access the Controls via their Shape Wrappers, wrap them with events and add to the Collection
    For Each mShape In osh.Shapes
        Set mControl = New clseFormControls
        mControl.Shape = mShape
        If mControl.controlType <> "OLEObject" Then
            mcolFormEvents.Add mControl, mControl.Name
        End If
    Next

'   Show the members of the collection
    mMSG = padLeft("Shape Name", col1) & "controlType" & vbCrLf & vbCrLf
    For Each mControl In mcolFormEvents
        With mControl
            mMSG = mMSG & padLeft(.Name, col1) & .controlType & vbCrLf
        End With
    Next mControl
    MsgBox mMSG

End Sub
Public Sub DoWithFormControl()
    MsgBox Application.Caller
End Sub

在工作表上收集UserForm控件

2 个答案: