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)
Related
I have a class that holds data in separate attributes (I chose this design instead of an array or scripting.dictionary because I will be using these data for the construction of a decision tree and I want to make use of IntelliType while I construct it.).
The data are loaded from an excel spreadsheet in the form of floats, so I am storing them in a long datatype, but from time to time it happens so that a value is missing and is replaced by an "NA" string.
I would like to create an error-handling routine, that, if a non-numeric value is encountered, would replace the content with a value -1.
I know I could do this with checking with IsNumeric() or error-handling, but I don't know how to make it work for every one of the many attributes the class holds and I don't really like the solution to write a specific error-handling code for every one of them (storing each of them in a separate attribute is not elegant as well, but I find this a price I am willing to pay for the advantage of shorter syntax in the decision tree).
Is there a way to pass a value to a variable, that just encountered a type-mismatch error, by the error-handling code independent of the variable name?
A simple example with several of the attributes:
Option Explicit
Dim B_LYM As Long
Dim B_mem As Long
Dim B_CXCR3 As Long
Dim B_CXCR4_MFI As Long
Public Sub SetData(data as Range)
On Error Goto err_handler
B_LYM = data.Cells(1, 1)
B_mem = data.Cells(1, 2)
B_CXCR3 = data.Cells(1, 3)
B_CXCR4_MFI = data.Cells(1, 4)
err_handler:
'I need something like this:
'if valuebeingstored = "NA" then targetvariable = -1
End Sub
It could be that some other approach could be better and I am gladly open to options, I only want to emphasize that I would really like make use of IntelliType when constructing the decision tree. I was considering using scripting.dictionary, but the syntax will bloat the code very quickly.
You said you have a Class and therefore could include the function to check the input and return -1 inside the class and use the Get and Let properties to call the function.
Here is an example class (named clsDataStuff) demonstrating this:
Option Explicit
Private c_B_LYM As Double
Private c_B_mem As Double
Private c_B_CXCR3 As Double
Private c_B_CXCR4_MFI As Double
Public Property Let B_LYM(varValue As Variant)
c_B_LYM = ParseDouble(varValue)
End Property
Public Property Get B_LYM()
B_LYM = c_B_LYM
End Property
Public Property Let B_mem(varValue As Variant)
c_B_mem = ParseDouble(varValue)
End Property
Public Property Get B_mem()
B_mem = c_B_mem
End Property
Public Property Let B_CXCR3(varValue As Variant)
c_B_CXCR3 = ParseDouble(varValue)
End Property
Public Property Get B_CXCR3()
B_CXCR3 = c_B_CXCR3
End Property
Public Property Let B_CXCR4_MFI(varValue As Variant)
c_B_CXCR4_MFI = ParseDouble(varValue)
End Property
Public Property Get B_CXCR4_MFI()
B_CXCR4_MFI = c_B_CXCR4_MFI
End Property
Private Function ParseDouble(varValue As Variant) As Double
If IsNumeric(varValue) Then
ParseDouble = CDbl(varValue)
Else
ParseDouble = -1
End If
End Function
Noting that:
the Let property expects a Variant because you say your input could be a number, or a string
the Get property returns Double as you said your inputs are floats so Double is better than Long
the ParseDouble function simply checks for a numeric input and returns -1 otherwise
Then, in your module code:
Option Explicit
Dim B_LYM As Long
Dim B_mem As Long
Dim B_CXCR3 As Long
Dim B_CXCR4_MFI As Long
Public Sub Test()
Dim objDataStuff As clsDataStuff
Set objDataStuff = New clsDataStuff
objDataStuff.B_LYM = 1 'data.Cells(1, 1)
objDataStuff.B_mem = 2 'data.Cells(1, 2)
objDataStuff.B_CXCR3 = "a" 'data.Cells(1, 3)
objDataStuff.B_CXCR4_MFI = True 'data.Cells(1, 4)
Debug.Print objDataStuff.B_LYM
Debug.Print objDataStuff.B_mem
Debug.Print objDataStuff.B_CXCR3
Debug.Print objDataStuff.B_CXCR4_MFI
End Sub
Returns an output of:
1
2
-1
-1
Intellisense is available and you get validation of the input:
Edit - regarding the comment on dynamically setting a target variable.
Your class can be:
Option Explicit
Public B_LYM As Double
Public B_mem As Double
Public B_CXCR3 As Double
Public B_CXCR4_MFI As Double
Public Sub SetVar(ByVal strVarName As String, ByVal varValue As Variant)
Dim dblValue As Double
Dim strToEval As String
If Not MemberExists(strVarName) Then Exit Sub
dblValue = ParseDouble(varValue) ' do the parse
CallByName Me, strVarName, VbLet, dblValue ' dynamically assign the value
End Sub
Private Function ParseDouble(varValue As Variant) As Double
If IsNumeric(varValue) Then
ParseDouble = CDbl(varValue)
Else
ParseDouble = -1
End If
End Function
Private Function MemberExists(strVarName) As Boolean
Dim blnTest As Boolean
Dim varValue As Variant
On Error GoTo ErrHandler
varValue = CallByName(Me, strVarName, VbGet)
blnTest = True
GoTo ExitFunction
ErrHandler:
blnTest = False
ExitFunction:
MemberExists = blnTest
End Function
Where:
All the variables are Public and you still get Intellisense but avoid all the repetitive Let and Get code
A single SetVar method uses CallByName to dynamically set a target variable
Two problems:
You need the clunky MemberExists function to prevent SetVar trying to assign a value to a member that does not exist - otherwise this generates an error (438) but perhaps this is something you need in your logic ?
You can still assign values to the target variable with e.g. objDataStuff.B_CXR3 = "foo" which alsos produces an error for anything other than a number.
The example code shows the problem below. But sticking with SetVar method will produce the same output as above.
Option Explicit
Dim B_LYM As Long
Dim B_mem As Long
Dim B_CXCR3 As Long
Dim B_CXCR4_MFI As Long
Public Sub Test()
Dim objDataStuff As clsDataStuff
Set objDataStuff = New clsDataStuff
objDataStuff.SetVar "B_LYM", 1
objDataStuff.SetVar "B_mem", 2
objDataStuff.SetVar "B_CXCR3", -1
objDataStuff.SetVar "B_CXCR4_MFI", True
objDataStuff.SetVar "foobar", 999
' working around SetVar here generates an error
objDataStuff.B_CXCR3 = "bad"
Debug.Print objDataStuff.B_LYM
Debug.Print objDataStuff.B_mem
Debug.Print objDataStuff.B_CXCR3
Debug.Print objDataStuff.B_CXCR4_MFI
End Sub
I'm learning VBA through Google, YouTube, etc.. and I came across Class Modules.
I have a Tracker Template.
Every few days I get a report sent to me ("Ice cream FG Inv.xlsm")
While trying to understand Class Modules, I found a template that created a Class Module (within the Tracker Template) WBIceCreamFGINVxlsm creating a CodeName for all of the worksheets within the Ice Cream FG Inv.xlsm Workbook.
Example:
Public Property Get wsinventory() As Worksheet
Set wsinventory = Workbook.Worksheets("Inventory")
End Property
In my module, I want to reference wsinventory, but not understanding exactly how to 'call' the Class Module..
Both Workbooks are Open.
I tried to start with:
Dim Data As Variant
Data = wsinventory.Range("A1").CurrentRegion.Value (**Variable not Defined**)
Then I tried:
Dim wsinventory As Worksheets
With wsinventory
Dim Data As Variant
Data = .Range("A1").CurrentRegion.Value (**Object variable or With variable not set**)
End With
Do I still need to use:
Dim DataSource As Workbook
Set DataSource = Workbooks("Ice Cream FG Inv.xlsm")
With DataSource.Worksheets("Inventory")
End With
If so, what would be the reasoning for using Class Modules?
You need to create a class object before you can access the properties of that class.
Assuming you have this Class and naming it TestClass:
Private pwsinventory As Worksheet
Public Sub init()
Set pwsinventory = Worksheets("Inventory")
End Sub
Public Property Set wsinventory(lwsinventory As Worksheet)
Set pwsinventory = lwsinventory
End Property
Public Property Get wsinventory() As Worksheet
Set wsinventory = pwsinventory
End Property
You can set / get the properties like so:
Sub test()
Dim datacls As TestClass
Dim data As Worksheet
Set datacls = New TestClass
Set datacls.wsinventory = Worksheets("inventory")
Set data = datacls.wsinventory
Debug.Print data.Name
End Sub
This, however, is kind of weird and when you have a property you don't want to set (you need to pass an argument) you should use an initiate function. Unfortunately there is no way I know of to do this without manually calling that sub after the class object is created.
Sub Test2()
Dim datacls As TestClass
Set datacls = New TestClass
datacls.init
Debug.Print datacls.wsinventory.Name
End Sub
The most common case I use classes for is better containers. Generally storing many of the same class type inside an array / dictionary so it is clear what I'm calling, especially if I need to modify the data in the same manner for each instance.
I am going to give another example. Create a class definition and name it ArrayData, and define multiple initialization subroutines
ArrayData.cls
Private m_data() As Variant
Private Sub Class_Initialize()
End Sub
Public Sub IntializeEmpty(ByVal rows As Long, ByVal columns As Long)
ReDim m_data(1 To count, 1 To columns)
End Sub
Public Sub InitializeFromRange(ByRef target As Range)
If target.rows.count > 1 Or target.columns.count > 1 Then
m_data = target.Value2
Else
ReDim m_data(1 To 1, 1 To 1)
m_data(1, 1) = target.Value
End If
End Sub
Public Sub InitializeFromArray(ByRef data() As Variant)
m_data = data
End Sub
Public Property Get RowCount() As Long
RowCount = UBound(m_data, 1) - LBound(m_data, 1) + 1
End Property
Public Property Get ColCount() As Long
ColCount = UBound(m_data, 2) - LBound(m_data, 2) + 1
End Property
Public Property Get Item(ByVal row As Long, ByVal col As Long) As Variant
Item = m_data(row, col)
End Property
Public Property Let Item(ByVal row As Long, ByVal col As Long, ByVal x As Variant)
m_data(row, col) = x
End Property
Module
To test the code in a code module initialize the class with the New keyword and then call one of the custom initialization subroutines.
Public Sub TestArray()
Dim arr As New ArrayData
arr.InitializeFromRange Sheet1.Range("A2").Resize(10, 1)
Dim i As Long
For i = 1 To arr.RowCount
Debug.Print arr.Item(i, 1)
Next i
End Sub
PS. Also read this article on how to designate one property as the default. In the example above if Item was the default property then you could write code such as
Debug.Print arr(5,2)
instead of
Debug.Pring arr.Item(5,2)
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
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
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