How to improve this Class Module definition - excel

I'm trying to create a class module that takes two arguments, inputted by user, and then make a calculation to create a private property that returns a calculated value
Here is what I got so far:
'clsItem Class Module
Option Explicit
Private mQt As Integer
Private mPrice As Double
Private mTotal As Double
Public Property Let Quantity(Value As Integer)
mQt = Value
End Property
Public Property Let Price(Value As Double)
mPrice = Value
End Property
Private Function SetTotal(mQt As Integer, mVl As Double)
mTotal = mQt * mPrice
End Function
Public Property Get Quantity() As Integer
Quantity = mQt
End Property
Public Property Get Price() As Double
Price = mPrice
End Property
Public Property Get Total() As Double
SetTotal mQt, mPrice 'This smells
Total = mTotal
End Property
The part where I've commented This smells is a kludge I put on so the code below gives the expected behavior:
'Object Module
Sub TestCls()
Dim basicItem As clsItem
Set basicItem = New clsItem
With basicItem
.Quantity = 100
.Price = 12.5
End With
Debug.Print basicItem.Total
End Sub
I think this is wrong because
I'm using a get property to call a function, but I've couldn't figure a way to place this calling anywhere else on the code.
If I don't call clsItem.Total somewhere in the module mTotal will never update.
I've tried using Class_Initialize() but it gives 0 since the .Quantity and .Price are not passed to the class yet.
So how can I make this right?

Remove the SetTotal
Just calculate the total in your Get Total()
So you end up with
'clsItem Class Module
Option Explicit
Private mQt As Integer
Private mPrice As Double
Public Property Let Quantity(Value As Integer)
mQt = Value
End Property
Public Property Get Quantity() As Integer
Quantity = mQt
End Property
Public Property Let Price(Value As Double)
mPrice = Value
End Property
Public Property Get Price() As Double
Price = mPrice
End Property
Public Property Get Total() As Double
Total = mQt * mPrice
End Property

Related

Implement scripting.dictionary item

I'm trying to create a class that inherits Scripting.Dictionnary to create hash tables with type restrictive keys and items.
The problem I encounter is that I don't find any documentation about how to implement this, and I have an error message telling me I must implement Item to interface dictionary.
Here is the prototype of my class :
Option Explicit
Implements Dictionary
Public Sub Add(nom As String, jour As Date, temps As Integer)
Supplier.Add nom, Array(jour, temps)
End Sub
Public Property Get Item(Key As String) As Array
Item = Supplier.Item(Key)
End Property
Public Property Set Item(Key As String, jour As Date, temps As Integer)
Set Supplier.Item(Key) = Array(jour, temps)
End Property
How should I Implement Item to make it work ? And is this the good way to achieve what I want ?
Your stated goal is to implement a strongly-typed Dictionary. To accomplish this goal, I would not implement an Interface. Rather, I would wrap the Dictionary in a class and achieve the strong-typing by using another class:
Supplier Class
Option Explicit
Private Supplier As Dictionary
Private Sub Class_Initialize()
Set Supplier = New Dictionary
End Sub
Public Sub Add(Key As String, Item As SupplierItem)
Supplier.Add Key, Item
End Sub
Public Property Get Item(Key As String) As SupplierItem
Set Item = Supplier.Item(Key)
End Property
Public Property Set Item(Key As String, Value As SupplierItem)
Set Supplier.Item(Key) = Value
End Property
SupplierItem Class
Option Explicit
Public jour As Date
Public temps As Integer
Testing Logic
Option Explicit
Public Sub Test()
Dim s As Supplier
Dim si As SupplierItem
Set s = New Supplier
Set si = New SupplierItem
si.jour = Now
si.temps = 3
s.Add "Key1", si
Debug.Print s.Item("Key1").temps
Set si = New SupplierItem
si.jour = Now
si.temps = 4
Set s.Item("Key1") = si
Debug.Print s.Item("Key1").temps
End Sub
You will need to implement all the functions/properties of what you are implementing.
Something like so
Option Explicit
Private d As Scripting.Dictionary
Implements Scripting.Dictionary
Public Sub Class_Initialize()
Set d = New Scripting.Dictionary
End Sub
Public Property Set Dictionary_Item(Key As Variant, RHS As Variant)
Set d.Item(Key) = RHS
End Property
Public Property Let Dictionary_Item(Key As Variant, RHS As Variant)
d.Item(Key) = RHS
End Property
Public Property Get Dictionary_Item(Key As Variant) As Variant
End Property
Public Sub Dictionary_Add(Key As Variant, Item As Variant)
End Sub
Public Property Let Dictionary_CompareMode(ByVal RHS As Scripting.CompareMethod)
End Property
Public Property Get Dictionary_CompareMode() As Scripting.CompareMethod
End Property
Public Property Get Dictionary_Count() As Long
End Property
Public Function Dictionary_Exists(Key As Variant) As Boolean
End Function
Public Property Get Dictionary_HashVal(Key As Variant) As Variant
End Property
Public Function Dictionary_Items() As Variant
End Function
Public Property Let Dictionary_Key(Key As Variant, RHS As Variant)
End Property
Public Function Dictionary_Keys() As Variant
End Function
Public Sub Dictionary_Remove(Key As Variant)
End Sub
Public Sub Dictionary_RemoveAll()
End Sub

Seting property of class

I have two classes
class Table which countains 2 informations (name and value)
Option Explicit
Private dName As String
Private dValue As Double
Property Get Name() As String
Name = dName
End Property
Property Let Name(Jmeno As String)
dName = Jmeno
End Property
Property Get Value() As Double
Value = dValue
End Property
Property Let Value(Hodnota As Double)
dValue = Hodnota
End Property
and main class where I use objects(in array) of class Table.
Option Explicit
Private dklicovaTeplota() As cls_Table
Property Get KlicovaTeplota(pozice As Integer) As cls_Table
Set KlicovaTeplota = dklicovaTeplota(pozice)
End Property
Property Set KlicovaTeplota(pozice As Integer, Jmeno As String, Hodnota As Double)
Dim temp As New cls_Table
temp.Name = Jmeno
temp.Value = Hodnota
Set dklicovaTeplota(pozice) = temp
End Property
When I run code I get error:
And when I come back to VBA editor the
Property Set KlicovaTeplota(pozice As Integer, Jmeno As String, Hodnota As Double)
is marked.
I have no idea where my property setting is inconsistent..

First Attempt at Object Oriented VBA fails

Question: Why do I get nothing but 0 out of this code? (via the MsgBox)
Context: Newbie trying to learn to use my own classes in Excel VBA.
Class1 is a class Module which has the code here:
Private pPhone As Integer
Public Property Get Phone() As Integer
Phone = pPhone
End Property
Public Property Let Phone(Value As Integer)
pPhone = Phone
End Property
And Test() is a sub in Module1 as you see here
Dim Home As Class1
Public Sub Test()
Set Home = New Class1
Home.Phone = 3
MsgBox Home.Phone
End Sub
The code executes, but Home.Phone is only reported as 0 (I guess the initial value) What am I doing wrong?
Change pPhone = Phone to pPhone = Value
It should be
Public Property Let Phone(Value As Integer)
pPhone = Value
End Property

VBA Class() object as property of another class

I'm trying to create a class to hold a variable number of items (which are themselves another class object).
So, I have Class 2:
' Class 2 contain each individual quote elements (OTC and MRC)
Private pOTC As String
Private pMRC As String
Public Property Get OTC() As String
OTC = pOTC
End Property
Public Property Let OTC(Value As String)
pOTC = Value
End Property
Public Property Get MRC() As String
MRC = pMRC
End Property
Public Property Let MRC(Value As String)
pMRC = Value
End Property
Then Class 1 contains an array of Class 2:
Private pCurr As String
Private pQuote(20) As Class2
Public Property Get Curr() As String
Curr = pCurr
End Property
Public Property Let Curr(Value As String)
pCurr = Value
End Property
Public Property Set Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property
Public Property Get Quote(Index As Integer) As Class2
Quote = pQuote(Index)
End Property
And what I would like to do is something like:
Dim myQuotes As Class1
Set myQuotes = New Class1
myQuotes.Curr = "GBP"
myQuotes.Quote(3).OTC = "1200"
The first line setting myQuotes.Curr is no problem, however when I try to set a value inside the array the next line errors with Run-time 91 Object variable or With block variable not set
Any pointers as to what I'm doing wrong and how can I set the values for the elements within the class array?
Thanks in advance!
When you myQuotes.Quote(3) you call Property Get Quote which has an issue.
Your internal array of Class2 is not instantiated so pQuote(Index) refers to an array element of Nothing, when you then myQuotes.Quote(3).OTC = you try to assign to Nothing which fails.
You need to make sure pQuote(Index) is instanced; you can do this on demand:
Public Property Get Quote(Index As Integer) As Class2
If (pQuote(Index) Is Nothing) Then Set pQuote(Index) = New Class2
Set Quote = pQuote(Index)
End Property
(Note the required Set)
Or by adding an intitialisation routine to Class1:
Private Sub Class_Initialize()
Dim Index As Long
For Index = 0 To UBound(pQuote)
Set pQuote(Index) = New Class2
Next
End Sub
You need to set them as New Class2 in Class1:
For intI = LBOUND(pQuote) to UBOUND(pQuote)
Set pQuote(intI) = New Class2
Next IntI
Just as you do with Class1 in your final script.
Maybe it should be
Public Property Let Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property

Class methods in VBA / VB

When trying to use a class in VBA I keep getting a subscript out of range error and could use some help here!
This is the class -
Option Explicit
Private buildWs As String
Public Property Get affBuild() As String
affBuild = buildWs
End Property
Public Property Let affBuild(value As String)
buildWs = affBuild
End Property
Public Function activate()
Sheets(buildWs).activate
End Function
This is the call -
Sub SetWs()
Dim current As CBuildSheet
Set current = New CBuildSheet
current.affBuild = "Resource Entry"
current.activate
End Sub
Your Let method should be using the value parameter:
Public Property Let affBuild(value As String)
buildWs = value
End Property
Your Public Function activate() is not returning any value.
Perhaps, you should use Public Sub activate().
this is wrong...
Public Property Let affBuild(value As String)
buildWs = affBuild
End Property
and should be...
Public Property Let affBuild(value As String)
buildWs = value
End Property
see . http://ramblings.mcpher.com/Home/excelquirks/snippets/classes for getting started with classes.
Bruce

Resources