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
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.