Beginner to excel class modules here. I am having trouble with the basics-
When I set (let) the property, I get "Compile error: Wrong number of arguments or invalid property assessment" with the .Name property:
Sub test()
Dim acc As account
Set acc = New account
MsgBox (acc.Name("First Account").rowNum())
End Sub
And this is the "account" class module:
Private strAccName As String
Private mlngRowNum As Long
Public Property Let Name(strN As String)
strAccName = strN
End Property
Public Property Get rowNum(exists As Boolean)
dim rowNum as Long
'...some logic here...
'...
getRowNum = rowNum
End Property
So supposedly I am going wrong in the Let method? Advice greatly appreciated
you can assign a value to a property LET (for normal dataTypes) or property SET (for Object) by the equal sign, not vith parenthesis (used for method instead), or read a property GET assigning the value to another variable, like this:
acc.Name = "xyz"
MsgBox acc.Name
This might help you:
Sub test_class()
Dim acc As account
Set acc = New account
acc.Name = "First Account"
MsgBox acc.rowNum(1)
End Sub
class (account):
Private strAccName As String
Private mlngRowNum As Long
Public Property Let Name(strN As String)
strAccName = strN
End Property
Public Property Get rowNum(exists As Boolean)
'Dim rowNum As Long
'...some logic here...
'...
If exists Then
'getRowNum = rowNum
rowNum = 5
Else
rowNum = 10
End If
End Property
Related
In VBA, you can use either Cells or Cells.Value, it has the same effect. Test1 and Test2 behaves the same way, allthough in test 2 the string is passed directly to the object.
Sub Test1()
Cells(1, 1) .Value = "Hello"
End Sub
Sub Test2()
Cells(1, 2) = "World"
End Sub
Is it possible to do something similar with any user class? Can-I assign a value directly to an object created from one of my classes withpout using the property value ?
Following Tim and K. recommendations, I've created a the following class:
Option Explicit
Dim LNG_Debut As Long
Public Property Let Debut(tLNG_Debut As Long)
LNG_Debut = tLNG_Debut
End Property
Property Get Debut() As Long
Debut = LNG_Debut
End Property
Then, I’ve exported that class to notepad and modified it the following way:
Property Get Debut() As Long
Attribute Debut.VB_UserMemId = 0
Debut = LNG_Debut
End Property
And finaly, I’ve imported it back in the VBA editor.
Then, both Test1 and Test2 have the same result
Sub Test1()
Dim MyVariable As obj_Test
Set MyVariable = New obj_Test
MyVariable.Debut = 10
End Sub
And
Sub Test2()
Dim MyVariable As obj_Test
Set MyVariable = New obj_Test
MyVariable = 10
End Sub
Many thanks
I wrote a class module called TimeManagementTable to abstract out some data for a table that I'm working with. Here's that code:
Option Explicit
Private table As ListObject
Private idColumn As Integer
Private subColumn As Integer
Private descColumn As Integer
Private epColumn As Integer
' ERROR -1: No Table
' ERROR -2: Columns Not Found
Public Function init(newSelection As Range) As Variant
Dim column As ListColumn
Dim msg As Variant
If newSelection.ListObject Is Nothing Then
msg = MsgBox("Table not detected!", vbCritical, "Aborted")
init = -1
Exit Function
End If
Set table = newSelection.ListObject
For Each column In table.ListColumns
Select Case column.Name
Case "ID"
idColumn = Int(column.Index)
Case "SUB"
subColumn = Int(column.Index)
Case "Description"
descColumn = Int(column.Index)
Case "EP"
epColumn = Int(column.Index)
End Select
If (idColumn > 0 And subColumn > 0 And descColumn > 0 And epColumn > 0) Then
Exit For
End If
Next
If (idColumn = 0 Or subColumn = 0 Or descColumn = 0 Or epColumn = 0) Then
msg = MsgBox("Either EP, ID, SUB, or Description column not detected!", vbCritical, "Aborted")
init = -2
Exit Function
End If
End Function
Public Property Get TableObject() As ListObject
Set TableObject = table
End Property
Public Property Get IDColumnInde() As Integer
IDColumnInde = idColumn
End Property
Public Property Get SUBColumnInde() As Integer
SUBColumnInde = subColumn
End Property
Public Property Get DescColumnInde() As Integer
DescColumnInde = descColumn
End Property
Public Property Get EPColumnInde() As Integer
EPColumnInde = epColumn
End Property
I have a call to the first Get property that looks like this:
Set newSelection = Application.InputBox("Please enter which Time Log table you would like to add a row to:", "Insert New Entry", "DeliverableTimeLog", , , , , 8)
Set tmt = New TimeManagementTable
If (tmt.init(newSelection) < 0) Then Exit Sub
For Each row In tmt.TableObject.ListRows
if row.Range.Formula(1, tmt.IDColumnIndex) = choiceID
Where tmt is an object of TimeManagementTable, row is a ListRow object, and choiceID is an integer.
Every Time I run the macro with the for each loop now I get
Runtime Error 451: Property let procedure not defined and property get
procedure did not return an object
at the end of this Get Property:
Public Property Get IDColumnIndex() As Integer
IDColumnIndex = idColumn
End Property
I feel like I'm losing my mind all it's doing is returning an integer. If anyone can help me understand what is going on that would be amazing. If you need more info let me know I tried to keep this as concise as possible.
EDIT: full class module source and initialization
That error is basically saying that you're trying to assign to a Property Get member.
SomeGetter = 42
That's illegal, because you can't assign to a property that doesn't have a Property Let accessor.
The part about "doesn't return an object" is because this:
SomeGetter = 42
Would be legal, if SomeGetter returned an object with a default member that's assignable to the RHS value. In other words because VBA can't see this:
SomeGetter.DefaultProperty = 42
Then it throws an error, because SomeGetter can't be LHS of an assignment. Look for a typo. Make sure every module says Option Explicit at the top, particularly the class module and the module with the loop that's throwing the error.
Your post looks like it contains multiple mixed versions of the code, making it hard to tell exactly where the problem is.
Actually...
if row.Range.Formula(1, tmt.IDColumnIndex) = choiceID
Formula is a Variant property, but I've never seen it indexed like this. I think that is the property VBA is complaining about. Did you mean to do this?
if row.Range.Cells(1, tmt.IDColumnIndex).Value = choiceID
Ok to start off, I read through this.
It is close although it doesn't answer my specific question. This talks about taking smaller collections and adding items to a larger main collection. Then destroying the smaller collection.
I have two definitions under Class Modules.
TimeDet
Option Explicit
Public recDate As String
Public recQty As String
Public recDieNo As String
Public recCatID As String
Public recCatName As String
Public recGroupID As String
Public recGroupName As String
TimeRec
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As TimeDet)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As TimeDet
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
Public Sub FillFromArray(Arr As Variant)
Dim i As Long, obj As TimeDet
For i = 1 To UBound(Arr)
Set obj = New TimeDet
obj.recDate = Arr(i, 1)
obj.recQty = Arr(i, 2)
obj.recDieNo = Arr(i, 3)
obj.recCatID = Arr(i, 4)
obj.recCatName = Arr(i, 5)
obj.recGroupID = Arr(i, 6)
obj.recGroupName = Arr(i, 7)
Me.Add obj
Next
End Sub
Then in the code I am using it this way:
Sub Test()
Dim RecSet1 As TimeRec, Record As TimeDet
Dim fSet1 As TimeRec, fRecord As TimeDet
Dim repArray() As Variant
Dim startDT As Date, endDT As Date, dieNo As String
repArray() = Sheet4.Range("A2:G" & Sheet4.Range("A2").End(xlDown).Row)
Set RecSet1 = New TimeRec
Set fSet1 = New TimeRec
RecSet1.FillFromArray (repArray())
startDT = "1-1-2015"
endDT = "1-1-2016"
dieNo = "16185"
For Each Record In RecSet1
If Record.recDate <= endDT And Record.recDate >= startDT And Record.recDieNo = dieNo Then
fSet1.Add (Record)
End If
Next
End Sub
I am getting an error when I try to add the Record object to the fSet1 object.
"Object doesn't support this method or property"
The Record object is Type TimeDet which as you can see up in the class module my Add method is expecting type TimeDet.
Either I am missing something very simple and have blinders on, or this is a bigger issue.
The array has 200,000 records roughly. I am attempting to create a smaller subset of filtered data. Maybe I am approaching this from the wrong way.
Your error is not at Add but at For Each
Most likely you copied your TimeRec Class. In VBA, you can't create enumerable classes inside the VBE (VBA IDE). There's a different way of creating Enumerable classes.
Open a notepad, copy all your class code and then add this attribute to NewEnum property Attribute NewEnum.VB_UserMemId = -4
Then import the class.
This is always hidden in VBA code, but can be seen in text editors.
Also add this attribute to Item property, it will make it default and allows syntax like ClassName(1)
Attribute Item.VB_UserMemId = 0
So , your code in text editor/ notepad should be:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private objTimeRec As Collection
Private Sub Class_Initialize()
Set objTimeRec = New Collection
End Sub
Private Sub Class_Terminate()
Set objTimeRec = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = objTimeRec.[_NewEnum]
End Property
Public Sub Add(obj As Class2)
objTimeRec.Add obj
End Sub
Public Sub Remove(Index As Variant)
objTimeRec.Remove Index
End Sub
Public Property Get Item(Index As Variant) As Class2
Attribute Item.VB_UserMemId = 0
Set Item = objTimeRec.Item(Index)
End Property
Property Get Count() As Long
Count = objTimeRec.Count
End Property
Public Sub Clear()
Set objTimeRec = New Collection
End Sub
The answer to this particular problem was to remove the parenthesis form my Add method. That being said, the attribute info being hidden was really good info and would have probably contributed to the problem after I figured out that removing the parenthesis fixed it.
I have created two classes, one being an interface for the other. Each time I try to instantiate Transition_Model I get:
Compile error: Object Module needs to implement '~' for interface'~'
To my understanding Implementing class is supposed to have a copy of all public subs, function, & properties. So I don't understant what is the problem here?
Have seen similar questions come up but either they refer to actual Sub or they include other complications making answer too complicated for me to understand.
Also note I tried changing Subs of Transition_Model to Private and add 'IModel_' in front of sub names(Just like top answer in second question I linked) but I still receive the same error.
IModel
Option Explicit
Public Enum Model_Types
Transition
Dummy
End Enum
Property Get M_Type() As Model_Types
End Property
Sub Run(Collat As Collateral)
End Sub
Sub Set_Params(key As String, value As Variant)
End Sub
Transition_Model
Option Explicit
Implements IModel
Private Transitions As Collection
Private Loan_States As Integer
Private Sub Class_Initialize()
Set Transitions = New Collection
End Sub
Public Property Get M_Type() As Model_Types
M_Type = Transition
End Property
Public Sub Run(Collat As Collateral)
Dim A_Transition As Transition
Dim New_Balance() As Double
Dim Row As Integer
For Row = 1 To UBound(Collat.Curr_Balance)
For Each A_Transition In Transitions
If A_Transition.Begining = i Then
New_Balance = New_Balance + Collat.Curr_Balance(Row) * A_Transition.Probability
End If
Next A_Transition
Next
End Sub
Public Sub Set_Params(key As String, value As Double)
Dim Split_key(1 To 2) As String
Dim New_Transition As Transition
Split_key = Split(key, "->")
Set New_Transition = New Transition
With New_Transition
.Begining = Split_key(1)
.Ending = Split_key(2)
.Probability = value
End With
Transitions.Add New_Transition, key
End Sub
Lastly the Sub I am using to test my class
Sub Transition_Model()
Dim Tested_Class As New Transition_Model
Dim Collat As New Collateral
'Test is the model type is correct
Debug.Assert Tested_Class.M_Type = Transition
'Test if Model without transition indeed does not affect balances of its collateral
Collat.Curr_Balance(1) = 0.5
Collat.Curr_Balance(2) = 0.5
Tested_Class.Run (Collat)
Debug.Assert ( _
Collat.Curr_Balance(1) = 0.5 And _
Collat.Curr_Balance(2) = 0.5)
End Sub
Actaully Per the second question I linked has the correct answer which I missed.
All subs need to start with 'IModel_' and rest ot the name has to match the name in IModel.
AND
This is the part i missed, you cannot use underscore in the Sub name.
I'm trying to create a custom property in an excel sheet, then retrieve its value. This is fine when I don't use an empty string, i.e. "". When I use the empty string, I get this error:
Run-time error '7':
Out of memory
Here's the code I'm using:
Sub proptest()
Dim cprop As CustomProperty
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("control")
sht.CustomProperties.Add "path", ""
For Each cprop In ThisWorkbook.Sheets("control").CustomProperties
If cprop.Name = "path" Then
Debug.Print cprop.Value
End If
Next
End Sub
The code fails at Debug.Print cprop.value. Shouldn't I be able to set the property to "" initially?
With vbNullChar it works, sample:
Sub proptest()
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("control")
' On Error Resume Next
sht.CustomProperties.Item(1).Delete
' On Error GoTo 0
Dim pathValue As Variant
pathValue = vbNullChar
Dim pathCustomProperty As CustomProperty
Set pathCustomProperty = sht.CustomProperties.Add("path", pathValue)
Dim cprop As CustomProperty
For Each cprop In ThisWorkbook.Sheets("control").CustomProperties
If cprop.Name = "path" Then
Debug.Print cprop.Value
End If
Next
End Sub
I think from the comments and the answer from Daniel Dusek it is clear that this cannot be done. The property should have at least 1 character to be valid, an empty string just isnt allowed and will give an error when the .Value is called.
So you Add this property with a length 1 or more string and you Delete the property again when no actual value is to be assigned to it.
As already mentioned it is not possible to set empty strings.
An easy workaround is to use a magic word or character, such as ~Empty (or whatever seems proof enough for you):
Dim MyProperty As Excel.CustomProperty = ...
Dim PropertyValue As String = If(MyProperty.Value = "~Empty", String.Empty, MyPropertyValue)
A slightly more expensive workaround but 100% safe is to start all the values of your custom properties with a character that you then always strip off. When accessing the value, systematically remove the first character:
Dim MyProperty As Excel.CustomProperty = ...
Dim PropertyValue As String = Strings.Mid(MyProperty.Value, 2)
You can write an extension to make your life easier:
<System.Runtime.CompilerServices.Extension>
Function ValueTrim(MyProperty as Excel.CustomProperty) As String
Return Strings.Mid(MyProperty.Value, 2)
End Function
Now you can use it like this: Dim MyValue As String = MyProperty.ValueTrim
Use a reversed principle when you add a custom property:
<System.Runtime.CompilerServices.Extension>
Function AddTrim(MyProperties As Excel.CustomProperties, Name As String, Value As String) as Excel.CustomProperty
Dim ModifiedValue As String = String.Concat("~", Value) 'Use ~ or whatever character you lie / Note Strig.Concat is the least expensive way to join two strings together.
Dim NewProperty As Excel.CustomProperty = MyProperties.Add(Name, ModifiedValue)
Return NewProperty
End Function
To use like this: MyProperties.AddTrim(Name, Value)
Hope this helps other people who come across the issue..
Based on the other answers and some trial and error, I wrote a class to wrap a Worksheet.CustomProperty.
WorksheetProperty:Class
Sets and Gets the value of a Worksheet.CustomProperty and tests if a Worksheet has the CustomProperty
VERSION 1.0 CLASS
Attribute VB_Name = "WorksheetProperty"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'#Folder("Classes")
'#PredeclaredId
Option Explicit
Private Type TMembers
Name As String
Worksheet As Worksheet
End Type
Private this As TMembers
Public Property Get Create(pWorksheet As Worksheet, pName As String) As WorksheetProperty
With New WorksheetProperty
Set .Worksheet = pWorksheet
.Name = pName
Set Create = .Self
End With
End Property
Public Property Get Self() As WorksheetProperty
Set Self = Me
End Property
Public Property Get Worksheet() As Worksheet
Set Worksheet = this.Worksheet
End Property
Public Property Set Worksheet(ByVal pValue As Worksheet)
Set this.Worksheet = pValue
End Property
Public Property Get Name() As String
Name = this.Name
End Property
Public Property Let Name(ByVal pValue As String)
this.Name = pValue
End Property
Public Property Get Value() As String
Dim P As CustomProperty
For Each P In Worksheet.CustomProperties
If P.Name = Name Then
Value = P.Value
Exit Property
End If
Next
End Property
Public Property Let Value(ByVal pValue As String)
Delete
Worksheet.CustomProperties.Add Name:=Name, Value:=pValue
End Property
Public Property Get hasCustomProperty(pWorksheet As Worksheet, pName As String) As Boolean
Dim P As CustomProperty
For Each P In pWorksheet.CustomProperties
If P.Name = pName Then
hasCustomProperty = True
Exit Property
End If
Next
End Property
Public Sub Delete()
Dim P As CustomProperty
For Each P In Worksheet.CustomProperties
If P.Name = Name Then
P.Delete
Exit For
End If
Next
End Sub
Usage
I have several properties of my custom Unit class return a WorksheetProperty. It makes it really easy to sync my database with my worksheets.
Public Function hasMeta(Ws As Worksheet) As Boolean
hasMeta = WorksheetProperty.hasCustomProperty(Ws, MetaName)
End Function
Public Property Get Id() As WorksheetProperty
Set Id = WorksheetProperty.Create(this.Worksheet, "id")
End Property
Public Property Get CourseID() As WorksheetProperty
Set CourseID = WorksheetProperty.Create(this.Worksheet, "course_id")
End Property
Public Property Get Name() As WorksheetProperty
Set Name = WorksheetProperty.Create(this.Worksheet, "unit_name")
End Property
Simple Usage
'ActiveSheet has a CustomProperty
Debug.Print WorksheetProperty.hasCustomProperty(ActiveSheet, "LastDateSynced")
'Set a CustomProperty
WorksheetProperty.Create(ActiveSheet, "LastDateSynced").Value = Now
'Retrieve a CustomProperty
Debug.Print WorksheetProperty.Create(ActiveSheet, "LastDateSynced").Value