简体   繁体   中英

Collecting UserForm Controls on a Worksheet

Objective : Create a Class to wrap Form controls and pass the name of the control to a common call-back on click.

I'm trying to access UserForm Controls that are on a Worksheet via the Shapes Collection for the sheet. The Shape object has a property called OLEFormat which, in turn, has an Object property which has a Type that reflects the MSForms properties (eg OptionButton ). This is the only way I can figure out to access the Form Controls on the sheet.

mShape.OLEFormat.Object

When I try to set a local MSForms object (eg MSForms.OptionButton ) to mShape.OLEFormat.Object , the VBA Runtime throws a Type Missmatch error.

Is this a quirk or is there a logical reason why this happens? Either way, how can I work around the problem? I think I can get it to work by declaring the local control in the Class as a Variant but I would love to know if there is a more logical way...

Custom Class:

'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

Test Code:

'//////////////////////////////////////////////////////////////////////////////////////
'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

The reason is that these two controls are of different type and can't by assigned to each other. Here example for two OptionButtons placed on a worksheet. First is Form-Control and second is ActiveX-Control.

在此处输入图片说明

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 

You can work around the problem if you use MSForm.OptionButton on the worksheet instead of Form-OptionButton.

For more information about Form and ActiveX Controls and when to use then have a look here: Overview of forms, Form controls, and ActiveX controls on a worksheet

HTH.

Thanks to guidance from @dee and @Rory , I came up with the following solution:

Key Points

  1. Put the common call-back in the onAction Macro of the Form Control
  2. use Application.Caller to get the Control Name

Custom Class:

'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

Test Code:

'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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM