WithEvent in Class module not getting variable from Let Property in Excel VBA - excel

I think I'm missing something simple here. Trying to use a variable in a Class module. Let and Get work fine. But if I try to use the variable in a different sub in the Class module I just get a value of 0.
Class Module clsCombobox
Public WithEvents ComboBox As MSForms.ComboBox
Public WithEvents ComboTextBox As MSForms.TextBox
Public Num As Long
Public Property Let Number(Value As Long)
Num = Value
End Property
Public Property Get Number() As Long
Number = Num
End Property
Private Sub ComboBox_Change()
Me.ComboTextBox.Value = Num
'this gives value of 0
End Sub
Userform Module
Dim obEvents as clsCombobox
Set obEvents = New clsCombobox
obEvents.Number = 52
MsgBox obEvents.Number 'this prints 52
Sub that sets ComboBox
Private Sub GroupCombobox()
Dim i As Long
Dim obEvents As clsCombobox
Set collCombobox = New Collection
For i = 1 To 5
Set obEvents = New clsCombobox
Set obEvents.ComboBox = Me.Controls("cbAbility" & i)
Set obEvents.ComboTextBox = Me.Controls("tbAbility" & i & "Text")
collCombobox.Add obEvents
Next i
End Sub

It doesn't look like you ever set the value. I assume you mean to do that in the loop? Perhaps not with the value of i, but here you can see the idea...
For i = 1 To 5
Set obEvents = New clsCombobox
'Set the value here
obEvents.Number = 52 ' 52 or whatever is needed as Number
Set obEvents.ComboBox = Me.Controls("cbAbility" & i)
Set obEvents.ComboTextBox = Me.Controls("tbAbility" & i & "Text")
collCombobox.Add obEvents
Next i

Related

How to assign a UserForm to a Class (Types)?

I'm trying to create a code that will be executed against all userforms in my workbook. So I wanted to create a Class. However, I'm stuck at this point.
The class name is clsCmdUsrFormsE
Variable declaration within the class:
Public WithEvents EndUserforms As UserForm
Objects assignation code:
Dim UserFormsAll() As New clsCmdUsrFormsE
Sub Cmd_UsrF(Optional var1 As Boolean = False)
Dim iCmdUsrFrm As Integer, UsrForm As Object
iCmdUsrFrm = 0
For Each UsrForm In WBK0001.VBProject.VBComponents
If UsrForm.Type = 3 Then
iCmdUsrFrm = iCmdUsrFrm + 1
ReDim Preserve UserFormsAll(1 To iCmdUsrFrm)
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UsrForm
End If
Next UsrForm
End Sub
& thew intent is to call Cmd_UsrF using a simple call
Sub Test()
Call Cmd_UsrF
End Sub
The problem I'm having is that it seems the Userform as Object is not compatible with the Class.
I've tried as well with
Public WithEvents EndUserforms As msforms.UserForm
But all I get is
Run-time error '13': Type mismatch
Any ideas?
You are tying to store VBComponent in MsForm and hence a type mismatch
Is this what you are trying?
Dim UserFormsAll() As New clsCmdUsrFormsE
Sub Cmd_UsrF(Optional var1 As Boolean = False)
Dim iCmdUsrFrm As Integer, UsrForm As Object
Dim frmname As String
iCmdUsrFrm = 0
For Each UsrForm In ThisWorkbook.VBProject.VBComponents
If UsrForm.Type = 3 Then
iCmdUsrFrm = iCmdUsrFrm + 1
ReDim Preserve UserFormsAll(1 To iCmdUsrFrm)
'~~> Get the Name of the form
frmname = UsrForm.Name
'~~> Load the form
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UserForms.Add(frmname)
End If
Next UsrForm
End Sub
In Class Module
Public WithEvents EndUserforms As MSForms.UserForm
Note:
You can also bypass the variable frmname and directly use
Set UserFormsAll(iCmdUsrFrm).EndUserforms = UserForms.Add(UsrForm.Name)

Trying to add Textboxes to a userform dynamically?

I have code inside a excel workbook that helps me create mass emails to send to users of various programs. I have a userform that pops up and the user populates all the info needed. but that only counts for one app at a time. Can someone share code with me that dynamically adds textboxes to a userform dependant on what checkboxes are ticked ?
In the first frame I have check boxes that indicate what applications are affected, second frame I have option buttons to describe what type of incident and then I would like the textboxes to appear according to what has been ticked.
Any guidance much appreciated as I think this is way too deep for me at the moment
I've reverse engineered this code it adds the boxes I want but I need to be able to populate them with cell data and then use it in the emails:
Option Explicit
Dim SpnColct As Collection
Private Sub CommandButton2_Click()
Dim cSpnEvnt As cControlEvent
Dim ctlSB As Control
Dim ctlTXT As Control
Dim lngCounter As Long
For lngCounter = 1 To 7
Set ctlTXT = Me.Frame7.Controls.Add("Forms.TextBox.1", "Text" & lngCounter)
ctlTXT.Name = "Text" & lngCounter
ctlTXT.Left = 5
ctlTXT.Height = 125: ctlTXT.Width = 280
ctlTXT.Top = (lngCounter - 1) * 125 + 2
Set cSpnEvnt = New cControlEvent
Set cSpnEvnt.SP = ctlSB
Set cSpnEvnt.TXT = ctlTXT
SpnColct.Add cSpnEvnt
Next lngCounter
Me.Frame1.ScrollHeight = (lngCounter - 1) * 17 + 2
End Sub
This added to a class module:
Option Explicit
Public WithEvents SP As MSForms.SpinButton
Public WithEvents TXT As MSForms.TextBox
Private Sub SP_SpinDown()
SP.Value = SP.Value - 1
MsgBox "Spin Down to " & SP.Value
End Sub
Private Sub SP_SpinUp()
SP.Value = SP.Value + 1
MsgBox "Spin Up to " & SP.Value
End Sub
Private Sub TXT_Change()
MsgBox "You changed the value."
End Sub
Updated This is going to be a bit of a long one - step through it see if you understand it. Have changed it to create the textboxes on the CheckBox_Click event but change to the commandbutton if you wish. Any more then this and I think you'll need to start a new question.
I've been doing something similar recently and found that the reason you're having issues is due to the order of loading objects. I unfortunately can't find the link that explains it at the moment (will update if can) but briefly to be able to achieve this you need an additional Class that does the loading of the objects, otherwise the Userform can't see them. This is the kind of solution that I came up with (using your example)
Userform:
Option Explicit
Private WithEvents cControls As EventController
Private Sub cControls_Click(ctrl As CheckBoxControl)
Dim tBox As TextBoxControl
Dim i As Long
Dim NextTop As Long, FrameHeight As Long
For i = 1 To cControls.GetControls.Count
Debug.Print TypeName(cControls.GetControl(i))
If TypeName(cControls.GetControl(i)) = "TextBoxControl" Then
Set tBox = cControls.GetControl(i)
If tBox.TXT.Parent Is Me.Frame7 Then
NextTop = tBox.Top + tBox.Height
End If
End If
Next i
Set tBox = cControls.AddTextBox
With tBox
.Height = 125
.Width = 280
.Left = 5
.Top = NextTop
.TXT.Text = ctrl.cBox.Caption
FrameHeight = NextTop + .Height
End With
If FrameHeight > Me.Frame7.InsideHeight Then
With Me.Frame7
.ScrollBars = fmScrollBarsVertical
.ScrollHeight = FrameHeight
.Scroll yAction:=6
End With
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim cBox As CheckBoxControl
Set cControls = New EventController
' This can be set to a userform or a frame
Set cControls.UserForm = Me
For i = 1 To 8
Set cBox = cControls.AddCheckBox
cBox.cBox.Left = 5
With cBox.cBox
.Top = 5 + (i - 1) * .Height
.Caption = IIf(i = 8, "App Unknown", "App " & i)
End With
Next i
End Sub
Private Sub cControls_Change(ctrl As TextBoxControl)
' This can be handled in the class instead as you were - just doing it in the userform to show the exposing of the event
MsgBox ctrl.TXT.Name & " Change"
End Sub
Private Sub cControls_SpinDown(ctrl As TextBoxControl)
' This can be handled in the class instead as you were - just doing it in the userform to show the exposing of the event
With ctrl.SP
If .Value >0 Then
.Value = .Value - 1
End If
End With
MsgBox ctrl.SP.Name & " Spin Down"
End Sub
Private Sub cControls_SpinUp(ctrl As TextBoxControl)
' This can be handled in the class instead as you were - just doing it in the userform to show the exposing of the event
With ctrl.SP
.Value = .Value + 1
End With
MsgBox ctrl.SP.Name & " Spin Up"
End Sub
Classes - These need to be named as in bold
EventControl
Option Explicit
Private CtrlCollection As Collection
Private cUserForm As UserForm1
Public Event SpinDown(ctrl As TextBoxControl)
Public Event SpinUp(ctrl As TextBoxControl)
Public Event Change(ctrl As TextBoxControl)
Public Event Click(ctrl As CheckBoxControl)
Public Property Set UserForm(v As UserForm1)
Set cUserForm = v
End Property
Public Property Get UserForm() As UserForm1
Set UserForm = cUserForm
End Property
Public Function AddTextBox() As TextBoxControl
Dim tBox As TextBoxControl
Set tBox = New TextBoxControl
tBox.Initialize Me
CtrlCollection.Add tBox
Set AddTextBox = tBox
End Function
Public Function AddCheckBox() As CheckBoxControl
Dim cBox As New CheckBoxControl
cBox.Initalize Me
CtrlCollection.Add cBox
Set AddCheckBox = cBox
End Function
Public Function GetControl(Index As Long)
Set GetControl = CtrlCollection(Index)
End Function
Public Function GetControls() As Collection
Set GetControls = CtrlCollection
End Function
Private Sub Class_Initialize()
Set CtrlCollection = New Collection
End Sub
Public Sub SpinDown(ctrl As TextBoxControl)
RaiseEvent SpinDown(ctrl)
End Sub
Public Sub SpinUp(ctrl As TextBoxControl)
RaiseEvent SpinUp(ctrl)
End Sub
Public Sub Change(ctrl As TextBoxControl)
RaiseEvent Change(ctrl)
End Sub
Public Sub Click(ctrl As CheckBoxControl)
RaiseEvent Click(ctrl)
End Sub
CheckBoxControl
Option Explicit
Public WithEvents cBox As MSForms.CheckBox
Private cParent As EventController
Public Property Set Parent(v As EventController)
Set cParent = v
End Property
Public Property Get Parent() As EventController
Set Parent = cParent
End Property
Public Sub Initalize(Parent As EventController)
Set Me.Parent = Parent
Set cBox = Parent.UserForm.Frame1.Controls.Add("Forms.CheckBox.1")
End Sub
Private Sub cBox_Click()
Parent.Click Me
End Sub
TextBoxControl
Option Explicit
Public WithEvents SP As MSForms.SpinButton
Public WithEvents TXT As MSForms.TextBox
Private cParent As EventController
Public Sub Initialize(Parent As EventController)
Set Me.Parent = Parent
With Parent.UserForm.Frame7.Controls
Set SP = .Add("Forms.SpinButton.1")
Set TXT = .Add("Forms.TextBox.1")
End With
End Sub
Public Property Set Parent(v As EventController)
Set cParent = v
End Property
Public Property Get Parent() As EventController
Set Parent = cParent
End Property
Public Property Let Left(v As Single)
TXT.Left = v
SP.Left = TXT.Left + TXT.Width
End Property
Public Property Get Left() As Single
Left = TXT.Left
End Property
Public Property Let Top(v As Single)
TXT.Top = v
SP.Top = v
End Property
Public Property Get Top() As Single
Top = TXT.Top
End Property
Public Property Let Height(v As Single)
TXT.Height = v
SP.Height = v
End Property
Public Property Get Height() As Single
Height = TXT.Height
End Property
Public Property Let Width(v As Single)
TXT.Width = v - SP.Width
SP.Left = TXT.Left + TXT.Width
End Property
Public Property Get Width() As Single
Width = TXT.Width + SP.Width
End Property
Public Sub SP_SpinDown()
Parent.SpinDown Me
' SP.Value = SP.Value - 1
' MsgBox "Spin Down to " & SP.Value
End Sub
' The commented out lines below you can either leave in here, or handle in the Userform
Public Sub SP_SpinUp()
Parent.SpinUp Me
' SP.Value = SP.Value + 1
' MsgBox "Spin Up to " & SP.Value
End Sub
Public Sub TXT_Change()
Parent.Change Me
' MsgBox "You changed the value."
End Sub
The issue is stemmed from that when the Userform is loaded the controls aren't loaded and therefore the Userform hasn't registered that they're something that has an Event. By using the intermediary class the Userform recognises that that class has an Event and we load this statically on initialize of the Userform. We can then add in whatever Controls we want to this Class and the Userform will handle them.
Demo:

Class Module codes for Change Event of comboboxes

I have a userform where I put 10 rows of comboboxes for 7 columns. Which means I got 70 comboboxes altogether. To ease your understanding, I will refer the first combobox as (1,1) for (row,column).
What am I trying to do is, when a user input values on any combobox on Row 1, I want the values to be copied on its adjacent combobox at Row 2.
For example, if I select value on (1,3), same value will appear on (2,3). The same thing goes to Row 3 & 4, Row 5 & 6, and so on.
This is the code on my class module clsLineCopy:
Public WithEvents myCbo As msForms.ComboBox
Private Sub myCbo_Change()
Dim i As Integer
'MsgBox "Combo Box " & myCbo.Value & " has changed"
If myCbo.Value <> "" Then
myCbo.Copy
myCbo.Paste
End If
End Sub
This one is my code on my userform_initialize:
Dim myCommonCbo As New Collection
Dim cbo As clsLineCopy
For i = 1 To 70
Set cbo = New clsLineCopy
Set cbo.myCbo = Me.Controls("ComboBox" & i)
myCommonCbo.Add Item:=cbo
Next i
Set cbo = Nothing
I know my code in the class module is wrong as I have no idea about it.
Thanks,
Izz.
In my demo I named the Userform -> FormComboGrid
Here are the changes you need:
Userform: Public CallBack method
Userform: Class level boolean variable used to prevent cascading CallBacks
myCommonCbo has to be elevated to a Class Level Variable. This keeps the references valid after the UserForm_Initialize finishes execution.
clsLineCopy should have an Init method used to pass a reference of the Userform instance and the Combobox that is being hooked.
FormComboGrid:Class
Option Explicit
Private myCommonCbo As New Collection
Private ComboBoxEventEnabled As Boolean
Private Sub UserForm_Initialize()
Dim i As Long
Dim cbo As clsLineCopy
For i = 1 To 70
Set cbo = New clsLineCopy
cbo.Init Me, Me.Controls("ComboBox" & i)
myCommonCbo.Add Item:=cbo
' Me.Controls("ComboBox" & i).List = Array(1, 2, 3, 4, 5, 6, 7)
Next i
ComboBoxEventEnabled = True
End Sub
Public Sub ComboboxChange(cbo As MSForms.ComboBox)
If Not ComboBoxEventEnabled Then Exit Sub
ComboBoxEventEnabled = False
Dim index As Long, r As Long, c As Long
Dim myCbo As MSForms.ComboBox
index = Replace(cbo.Name, "ComboBox", "")
c = index Mod 10
r = Int(index / 10) + 1
If r = 7 Then Exit Sub
index = ((r * 10) + c)
Set myCbo = Me.Controls("ComboBox" & index)
myCbo.Value = cbo.Value
ComboBoxEventEnabled = True
End Sub
clsLineCopy:Class
Option Explicit
Private WithEvents myCbo As MSForms.ComboBox
Private mForm As FormComboGrid
Private Sub myCbo_Change()
mForm.ComboboxChange myCbo
End Sub
Public Sub Init(Form As FormComboGrid, cbo As MSForms.ComboBox)
Set mForm = Form
Set myCbo = cbo
End Sub

How do you use a public variable in a Class Module?

I'm using a Class Module to make a collection of save buttons all do the same thing. But when I try to get them to run a sub that requires a variable I can't get the variable passed to them.
Edited using #Teasel's advice about properties. The problem seems to be the Let Property is not allowing me to set the variable from Module1.
Class1
Public WithEvents SaveBtn As MSForms.CommandButton
Dim currentrow As Long
Private Sub SaveBtn_Click()
SendMessage
`Even if I just have it Msgbox currentrow it returns 0
End Sub
Property Let GetRow(myrow As Long)
currentrow = myrow
End Property
Property Get GetRow() As Long
GetRow = currentrow
End Property
Module1
`Trying to send the value into the Class using Let
Private Sub SendRow_Click()
Module1.GetRow = 22
End Sub
`Trying to Get the value back from the Class
Public Sub SendMessage()
Dim therow As Long
therow = Module1.GetRow
`I get the "Method or Data Member not found" error in the line above
MsgBox therow
End Sub
UserForm1
`This part works fine
Dim colSaveButtons As New Collection
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As MSForms.Control
Dim obEvents As Class1
For Each ctl In Me.Controls
If TypeOf ctl Is MSForms.CommandButton Then
For i = 0 To 5
If ctl.Name = "btnSavePage" & i Then
Set obEvents = New Class1
Set obEvents.SaveBtn = ctl
colSaveButtons.Add obEvents
End If
Next
End If
Next ctl
End Sub
Add a "CurrentRow" field to your class module:
Public WithEvents SaveBtn As MSForms.CommandButton
Public CurrentRow As Long '<< add this
Private Sub SaveBtn_Click()
SendMessage CurrentRow
End Sub
In your loop:
...
If ctl.Name = "btnSavePage" & i Then
Set obEvents = New Class1
obEvents.CurrentRow = 10 'or whatever...
Set obEvents.SaveBtn = ctl
colSaveButtons.Add obEvents
End If
...
And your SendMessage method:
Public Sub SendMessage(CurrentRow As Long)
MsgBox "This works"
End Sub
You can use two differents ways to achieve that.
1. Public Property
To simple access your variable's value you need a Get property and to set its value you need a Let property.
In your Module:
'Your module private variable
Dim nameOfYourModuleVariable As String
...
'Set property to assign a value to your variable
Public Property Let nameOfYourProperty(value As String)
nameOfYourModuleVariable = value
End Property
'Get property to return the value of your variable
Public Property Get nameOfYourProperty() As String
nameOfYourProperty = nameOfYourModuleVariable
End Property
You can then use it like this:
'Set the value
MyModule.nameOfYourProperty = "foo"
'Get the value
MyModule.nameOfYourProperty
I highly recommend to use properties to do such things however you can also simply set your variable as public as shown in point 2.
2. Public Variable
Define your variable to be public so you can access it from everywhere.
In your Module:
Public nameOfYourVariable As String
Get or set the value from another module:
'Set the value
MyModule.nameOfYourVariable = "foo"
'Get the value
MyModule.nameOfYourVariable

Trying to set up a custom object model using example, not working

I am trying to set up a custom object model using an example I found in an answered question here on stackoverflow.
VBA Classes - How to have a class hold additional classes
Here is the code I have created based on the answer.
Standard Module
Sub test()
Dim i As Long
Dim j As Long
'code to populate some objects
Dim AssemList As Collection
Dim Assem As cAssem
Dim SubAssemList As Collection
Dim SubAssem As cSubAssem
Set AssemList = New Collection
For i = 1 To 3
Set SubAssemList = New Collection
Set Assem = New cAssem
Assem.Description = "Assem " & i
For j = 1 To 3
Set SubAssem = New cSubAssem
SubAssem.Name = "SubAssem" & j
SubAssemList.Add SubAssem
Next j
Set Assem.SubAssemAdd = SubAssemList '<------ Object variable or With Block not Set
AssemList.Add Assem
Next i
Set SubAssemList = Nothing
'write the data backout again
For Each clock In AssemList
Debug.Print Assem.Description
Set SubAssemList = Assem.SubAssems
For Each SubAssem In SubAssemList
Debug.Print SubAssem.Name
Next
Next
End Sub
cAssem Class
Private pDescription As String
Private pSubAssemList As Collection
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
Public Property Get Description() As String
Description = pDescription
End Property
Public Property Let Description(ByVal sDescription As String)
pDescription = sDescription
End Property
Public Property Get SubAssems() As Collection
Set SubAssems = pSubAssemList
End Property
Public Property Set SubAssemAdd(AssemCollection As Collection)
For Each AssemName In AssemCollection
pSubAssemList.Add AssemName ' <------- This is the line that is triggering the error
Next
End Property
cSubAssem Class
Private pSubAssemName As String
Public Property Get Name() As String
Name = pSubAssemName
End Property
Public Property Let Name(ByVal sName As String)
pSubAssemName = sName
End Property
I have not changed anything in the code except class names and variable names and from my limited point of view I cannot understand the cause of the error.
I am just starting to really dig into objects and Class Modules in VBA so I appreciate any knowledge this community could pass my way.
Many Thanks
You have a typo in your sub class initializer:
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
should read:
Private Sub Class_Initialize()
Set pSubAssemList = New Collection
End Sub

Resources