I'm new in Object Oriented Programming in VBA and I'm trying to write my first class.
I'm following guides on the Internet for it.
But I get errors I don't understand.
Let and Set properties are not recognized and appear in red. The same is true for Sub when I try to pass them Parameters.
Would you happen to know where the issue can come from ?
Option Explicit
Private pNumShare As Integer
Private pNumPlan As Integer
Private pName As String
Public Property Get NumShare() As Integer
NumShare = pNumShare
End Property
Public Property Let NumShare(int AS Integer)
pNumShare = int
End Property
Public Sub Class_Initialize()
NumShare = Empty
NumPlan = Empty
Name = Empty
End Sub
Public Sub setColonne(int As Integer)
End Sub
The expression int is a function and therefore a reserved word in VBA. Use a different variable name.
See here
(And please Edit your question to Add your code...Images for code are not helpful)
Also the syntax is Property Set as in this link
Related
I'm trying to refactor some Excel VBA code (Excel 2016, VBA 7.1) to eliminate repetitive subroutines for maintainability purposes. Several of the subroutines only differ by the group of global constants they use, so what I'm basically trying to do is group the globals together into a struct-like data structure so I can pass them into a common function as an argument.
Note that the groups of global constants have some in common, but not all, e.g.:
Global Const GROUP1_SHEET As String = "Sheet1"
Global Const GROUP1_FIRST_ROW As Long = 2
Global Const GROUP1_LAST_COL As Long = 15
Global Const GROUP1_SOME_COL_OFFSET = 4
Global Const GROUP2_SHEET As String = "Sheet2"
Global Const GROUP2_FIRST_ROW As Long = 2
Global Const GROUP2_LAST_COL As Long = 8
Global Const GROUP2_ANOTHER_COL_OFFSET = 2
And there are different subroutines for each group, e.g.:
In Sheet1:
Private Sub DoSomething()
Set w = Worksheets(GROUP1_SHEET)
'some code
End Sub
In Sheet2:
Private Sub DoSomething()
Set w = Worksheets(GROUP2_SHEET)
'same code as above
End Sub
There are dozens of these. Needless to say, this code is a nightmare to even read through, let alone maintain.
What I'm trying to do right now is split the groups into separate modules and set them as properties, similar to what is described in this question. The problem with this is I don't know how to pass the module (i.e. the group of globals) to the function as an argument.
In new module GROUP1:
Public Property Get SHEET() As String
SHEET = "Sheet1"
End Property
And this works as I want it to:
Public Sub ShowPopup()
MsgBox GROUP1.SHEET
End Sub
But passing it as an argument does not:
Public Sub Popup(inModule As Object)
MsgBox inModule.SHEET
End Sub
Public Sub ShowPopUp()
Popup GROUP1
End Sub
Nothing I've tried works in place of "Object" in the example above. I either get "ByRef Argument type mismatch" or "Expected variable or procedure, not module" depending on what I put there.
So, can I pass a module like this (maybe as a string and evaluate it somehow?), or should I use some other way of grouping globals?
You cannot pass regular modules as arguments (technically you can pass a string and use Application.Run, but that might be a nightmare to deal with), but you can pass classes.
Classes can be in global scope. So technically you can instantiate it at some point (opening a workbook for example) and then use them at any point. I would say that globals are fine in some cases, but most of the time you can (and perhaps should) do without them. I would encourage you to look at the topic of global scope and why it often considered to be bad.
You can have a class like this:
GroupClass:
Option Explicit
Private Type TypeGroup
WS as WorkSheet
FirstRow as Long
FirstCol as Long
ColumnOffset as Long
End Type
Private This as TypeGroup
Public Function Initialize(Byval WS as Sheet, Byval FirstRow as Long, ByVal FirstCol as Long, ByVal ColumnOffset as Long)
With This
Set .WS = WS
.FirstRow = FirstRow
.FirstCol = FirscCol
.ColumnOffset = ColumnOffset
End with
End Function
Public Property Get Name() as String
Name = This.WS.Name
End Property
Then you can use it like this:
Public Sub Popup(Group As GroupClass)
MsgBox Group.Name
End Sub
Public Sub ShowPopUp()
Dim Group1 as GroupClass
Set Group1 = New GroupClass
Group1.Initialize Worksheets("Sheet1"),2,15,4
Popup Group1
End
The reason I use Private Type and Private This as TypeGroup can be found here. Some caveats for class instantiation can be seen here. Depending on what you do, your class organization can be very different. You can read on interfaces, immutability, when to use getters/setters, encapsulation and other topic elsewhere.
Edit:
The three main things I'm looking to accomplish here are:
To be able to encapsulate properties/methods into a class (easy enough)
Use excel ranges as a user input for users to manipulate class property values.
(bonus) Send user changes back up to a database.
I've been playing with the idea of building something in vba that would allow me to bind an object's property(ies) to a Range. Basically turning a cell into a bound control.
Some basic requirements I might be after include:
A change to the object property would update the cell value
A change to the cell would update the object property
The object property may be bound/unbound without losing the value of the property.
My initial thought is to build a BindRange class that simply gets its value from a range and sets its value to that range.
BindRange.cls:
Option Explicit
Private p_BoundCell As Range
Public Property Get Value() As String
If Me.IsBound Then Value = p_BoundCell.Value
End Property
Public Property Let Value(Val As String)
If Me.IsBound Then p_BoundCell.Value = Val
End Property
Public Property Get IsBound() As Boolean
If BoundToDeletedCell Then
Set p_BoundCell = Nothing
End If
IsBound = Not (p_BoundCell Is Nothing)
End Property
Public Sub Bind(Cell As Range)
Set p_BoundCell = Cell(1, 1)
End Sub
Private Function BoundToDeletedCell() As Boolean
Dim sTestAddress As String
On Error Resume Next
TRY:
If p_BoundCell Is Nothing Then
Exit Function
'// returns false
End If
sTestAddress = p_BoundCell.Address
If Err.Number = 424 Then 'object required
BoundToDeletedCell = True
End If
End Function
Then, I can set up my custom object with a pair of fields to manage the updates. I would also need a method to expose setting the range to be bound.
TestObject.cls:
Option Explicit
Private p_BindId As BindRange
Private p_Id As String
Public Property Get Id() As String
If p_BindId.IsBound Then
p_Id = p_BindId.Value
End If
Id = p_Id
End Property
Public Property Let Id(Val As String)
p_Id = Val
If p_BindId.IsBound Then
p_BindId.Value = p_Id
End If
End Property
Public Sub Id_Bind(Cell As Range)
p_BindId.Bind Cell
End Sub
Private Sub Class_Initialize()
Set p_BindId = New BindRange
End Sub
Private Sub Class_Terminate()
Set p_BindId = Nothing
End Sub
This could be annoying because any property I want to make "Bindable" I'll have to manage Get/Set and Bind for each. I'm also not too sure if this will cause any memory issues: making class-properties with variant typed values....
Also considering building a service-like class that keeps track of objects and their bound ranges in a dictionary-like structure?
Anyways, just curious if anyone has done something like this before or if you have any thoughts on how you might design this.
Binding individual cells to properties would be very cumbersome. I think a better technique would be to create a table to act as a property sheet and a PropertySheetWatcher that raise a PropertyChange event.
Let's say for instance that we wanted to create a simple game on a userform call Stack OverKill. Our game will have its Hero Class and multiple Enemies classes (e.g. Turtle, Rhino, Wolf). Although each class has its own business logic they all share common properties (Name, HP, ClassName, Left, Right ...etc). Naturally, since they all sure the same basic set of properties they should all Implement a common Interface (e.g. CharacterInterface). The beauty of this is they can all share the same Property Sheet Table.
Mock Property Sheet Table
PropertySheetWatcher:Class
Private WithEvents ws As Worksheet
Public Table As ListObject
Public Event PropertyChange(ByVal PropertyName As String, Value As Variant)
Public Sub Init(ByRef PropertySheetTable As ListObject)
Set ws = PropertySheetTable.Parent
Set Table = PropertySheetTable
End Sub
Private Sub ws_Change(ByVal Target As Range)
Dim PropertyName As String
If Not Intersect(Target, Table.DataBodyRange) Then
PropertyName = Intersect(Target.EntireColumn, Table.HeaderRowRange).Value
RaiseEvent PropertyChange(PropertyName, Target.Value)
End If
End Sub
Public Sub UpdateProperty(ByVal PropertyName As String, Name As String, Value As Variant)
Application.EnableEvents = False
Dim RowIndex As Long
RowIndex = Table.ListColumns("Name").DataBodyRange.Find(Name).Row
Table.ListColumns(PropertyName).DataBodyRange.Cells(RowIndex).Value = Value
Application.EnableEvents = True
End Sub
Hero:Class
Implements CharacterInterface
Private Type Members
Name As String
HP As Single
ClassName As String
Left As Single
Right As Single
Top As Single
Bottom As Single
Direction As Long
Speed As Single
End Type
Private m As Members
Public WithEvents Watcher As PropertySheetWatcher
Private Sub Watcher_PropertyChange(ByVal PropertyName As String, Value As Variant)
Select Case PropertyName
Case "Speed"
Speed = Value
Case "HP"
'....More Code
End Select
End Sub
Public Property Get Speed() As Single
Speed = m.Speed
End Property
Public Property Let Speed(ByVal Value As Single)
m.Speed = Speed
Watcher.UpdateProperty "Speed", m.Name, Value
End Property
Private Property Get CharacterInterface_Speed() As Single
CharacterInterface_Speed = Speed
End Property
Private Property Let CharacterInterface_Speed(ByVal Value As Single)
Speed = Value
End Property
The classes above give are a quick muck-up of how the notification system can be implemented. But wait there is more!!!
Look how easy it is to setup a Factory to reproduce all of out Characters based off the saved setting.
CharacterFactory:Class
Function AddCharacters(Watcher As PropertySheetWatcher) As CharacterInterface
Dim Table As ListObject
Dim data As Variant
Dim RowIndex As Long
With Table
data = .DataBodyRange.Value
For RowIndex = 1 To UBound(data)
Select Case data(RowIndex, .ListColumns("Class").Index)
Case "Hero"
Set AddCharacters = AddCharacter(New Hero, Table, RowIndex)
Case "Turtle"
Set AddCharacters = AddCharacter(New Turtle, Table, RowIndex)
Case "Rhino"
Set AddCharacters = AddCharacter(New Rhino, Table, RowIndex)
Case "Wolf"
Set AddCharacters = AddCharacter(New Wolf, Table, RowIndex)
End Select
Next
End With
End Function
Private Function AddCharacter(Character As CharacterInterface, Table As ListObject, RowIndex As Long) As Object
With Character
.Speed = Table.ListColumns("Speed").DataBodyRange.Cells(RowIndex).Value
'....More Coe
End With
Set AddCharacter = Character
End Function
It may seem like I wrote a lot of original content but I didn't. The whole setup is an adaptation of concepts taken from different popular design patterns.
I am trying to implement a Model-View-Presenter Userinterface in VBA excel. In order to do this I have been writing different Model classes. Here an Example:
Option Explicit
Private Type TModel
FilterCol As Collection
N As Integer
End Type
Private this As TModel
Public Property Get FilterCol() As Collection
Set FilterCol = this.FilterCol
End Property
Public Property Let FilterCol(ByVal value As Collection)
Set this.FilterCol = value
End Property
Public Property Get N() As Integer
Set N = this.N
End Property
Public Property Let N(ByVal value As Integer)
Set this.N = value
End Property
This class called "FilterModel" is a collection of MSFormObjects. In order to use the collection properly I need to new it. So the code where I use it would look a little like this:
Sub testFilter()
Dim Filterm As FilterModel
Dim DefaultFilterLine As New FilterLine
Set Filterm = New FilterModel
Filterm.FilterCol = New Collection
'Set DefaultFilter
Filterm.FilterCol.Add DefaultFilterLine
'DoStuff
With New frmFilter
Set .Model = Filterm
.Show
End With
End Sub
If I don't new the Property FilterCol before I add something, in this case the defaultfilter, it doesn't work. So here is my Question:
Is there a way to overwrite the new statement for my new class in order to have it also new up the collection FilterCol. My research got me as far as I now know that this would be called a constructor.
But how would one properly implement a constructor for a VBA class?
Somthing like:
Private Sub Class_Initialize()
Set this.FilterCol = New Collection
N = 0
End Sub
If I do this then I get an error in the "Property Let N(Byval Value as integer)" Line. The error message reads "object required".
Here is a working solution. I suggest going through the code line-by-line using F8 to understand what is happening there. Debug.print prints values into the Immediate window.
Here is the FilterModel class:
''' FilterModel class
Option Explicit
Private pFilterCol As Collection
Private pN As Integer
Public Property Get FilterCol() As Collection
Set FilterCol = pFilterCol
End Property
Public Property Let FilterCol(ByVal value As Collection)
Set pFilterCol = value
End Property
Public Property Get N() As Integer
N = pN
End Property
Public Property Let N(ByVal value As Integer)
pN = value
End Property
Private Sub Class_Initialize()
Set pFilterCol = New Collection
pN = 0
End Sub
and here is module code to test it:
''' random module
Option Explicit
Sub testFilter()
Dim Filterm As FilterModel
Set Filterm = New FilterModel
Filterm.FilterCol = New Collection
''' default values (specified in Class_Initialize())
Debug.Print Filterm.N
Debug.Print Filterm.FilterCol.Count
''' set the values through Property Let
Filterm.FilterCol.Add "whatever"
Filterm.FilterCol.Add "whenever"
Filterm.N = 6
''' print the new values (through Property Get)
Debug.Print Filterm.N
Debug.Print Filterm.FilterCol.Count
Debug.Print Filterm.FilterCol(1)
Debug.Print Filterm.FilterCol(2)
End Sub
I'm pretty new to this, so I'm sorry if I screw up any of the lingo. Thanks a bunch for anybody's help or thoughts.
I have the following wrong code:
Sub ExampleSub(text As String)
ClassObject." & text & "_attribute = 1
End Sub
So if I call ExampleSub("cheese"), I would like it to set ClassObject.cheese_attribute equal to 1.
Any thoughts? I'm not even sure it's possible.
Thanks so much!
Here is another method that might work. Use a scripting dictionary object as one of the classobject's Properties. The Dictionary Object is pretty neat, storing elements in key/value pairs, where the key is a string and the value can be any other type (object, range, Workbook, integer, variant/array, etc.)
So you can use the dictionary object to contain all of these named attributes. In your class module, add code like:
Private pAttributes as Object
Sub Class_Initialize()
'## Initialize this object to avoid a 91 error
Set pAttributes = CreateObject("Scripting.Dictionary")
End Sub
Public Property Get Attributes() As Object
Set Attributes = pAttributes
End Property
Public Property Let Attributes(lAttributes As Object)
Set pAttributes = lAttributes
End Property
Then, in your code you can simply do:
Sub ExampleSub(text As String)
ClassObject.Attributes(text) = 1
End Sub
Calling a dictionary key automatically adds the item if it doesn't already exist, but if you wanted more control you could do:
Sub AnotherExample(text as String)
If ClassObject.Attributes.Exists(text) Then
MsgBox text & " already exists!", vbInformation
Else:
ClassObject.Attributes(text) = 1
End If
End Sub
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