Home » excel » excel – VBA First time creating Class

excel – VBA First time creating Class

Posted by: admin May 14, 2020 Leave a comment

Questions:

I’m currently working on a VBA project. I only have experience in the basics of VBA (No OOP, just functions and subs) and C#.

Today I am trying to create my first class but i run into an error.

This is how the class looks like:

'CLASS Disponent

 Private Sub Class_Initialize()
      m_dispocode = 1
      m_name = Unknown
      m_suppliers
      m_materials
      SetID
End Sub

Private m_materials As New ArrayList
Private m_suppliers As New ArrayList
Private m_name As String
Private m_dispocode
Private m_id As String

Property Get Id() As Integer
    Id = m_id
End Property

Property Get Suppliers(value As Integer) As String
If value >= 0 And value < m_suppliers.Count Then
        Suppliers = m_suppliers(value)
Else
    Err.Raise ERROR_INVALID_INDEXING, "ReadWorksheet", "The indexer used in the arraw is out of bounds"
End If
End Property

Property Let Suppliers(supp As String)
    m_suppliers.Add supp
End Property

Property Get Dispocode() As Integer
 Dispocode = m_dispocode
End Property

Property Let Dispocode(dispcode As Integer)
If dispcode > 0 And dispcode < 1000 Then
    m_dispocode = dispcode
Else
    Err.Raise ERROR_INVALID_DISPOCODE, "ReadWorksheet", "The value must be between 1 (incl) and 999 (incl)"
End If
End Property

Property Get name() As String
    name = m_name
End Property

Property Let name(name As String)
    If Len(name) > 3 Then
    m_name = name
    Else
    Err.Raise ERROR_INVALID_NAME, "ReadWorksheet", "The name must be at least 3 letters long"
End Property

Property Get Materials(indexof As Integer) As ArrayList
If indexof >= 0 And indexof < m_suppliers.Count Then
    Materials = m_materials(indexof)
Else
    Err.Raise ERROR_INVALID_INDEXING, "ReadWorksheet", "The indexer used in the arraw is out of bounds"
End If
End Property

Property Let Materials(materialnum As String)
     m_materials.Add materialnum
End Property

Public Sub SetID()
    m_id = m_name & m_dispocode
End Sub

And this is how I try to create my objects in a SUB in a normal Module:

Sub GenerateDisponents()
Dim last_row As Long
last_row = Sheets("Disponents").Cells(Rows.Count, 1).End(xlUp).Row

Dim Dispos As New Collection

For i = 1 To last_row
    Dim temp As New Disponent

    Dim name As String
    name = Sheets("Disponents").Range("B" & i).value
    Dim code As Integer
    code = Sheets("Disponents").Range("A" & i).value

    temp.name = name
    temp.Dispocode = code

    Dispos.Add temp


MsgBox ("DONE")
End Sub

When I try to run GenerateDisponents sub I get the following error on the Let Materials property:
“Definitions of property procedures for the same property are inconsistent, or property procedure has an optional parameter, a ParamArray, or an invalid Set final parameter.”

For the early binding I use the following reference: C:\Windows\Microsoft.NET\Framework\v4.0.30319.\mscorlib.dll.

Do you guys have any idea why my code isn’t working?

I am sure its full of mistakes because it’s my first time trying using classes in VBA.

Thanks for the help in advance!

How to&Answers:

Property Get Materials(indexof As Integer) As ArrayList says an ArrayList is to be returned but Property Let Materials(materialnum As String) wants a string to be assigned to it – the property types must match.

As an array is backing this propery obj.Materials = "Hello" doesn’t make much sense; you need to do what ArrayList does an use a .Add() / .Item() methods.

Is there a reason for using ArrayList rather than one of the built in types?

Answer:

Try this:

A few notes:

1) Properties shouldn’t raise errors. If you need to raise an error, change the property to a method.

2) I’d like to say “injected” but it’s inaccurate, so I set an IErrorHandler through a property to handle errors in the class. You can change it to a method, e.g. Init(ByVal objHandler as IErrorHandler) or handle them as you like, but please don’t show message-boxes through the class.

3) Lastly, I changed the ArrayList to a Collection.

Disponent class:

Option Explicit

Private m_errorHandler As IErrorHandler
Private m_materials As Collection
Private m_suppliers As Collection
Private m_name As String
Private m_dispocode As Integer
Private m_id As Integer

'// Properties
Property Let ErrorHandler(ByVal obj As IErrorHandler)
    Set m_errorHandler = obj
End Property

Property Get Id() As Integer
    Id = m_id
End Property

Property Get Name() As String
    Name = m_name
End Property

Property Let Material(ByVal materialnum As String)
     m_materials.Add materialnum
End Property

Property Let Supplier(ByVal supp As String)
    m_suppliers.Add supp
End Property

Property Get Dispocode() As Integer
    Dispocode = m_dispocode
End Property


'// Methods
Public Sub SetID()
    m_id = m_name & m_dispocode
End Sub

Public Function GetSupplier(ByVal index As Integer) As String
    On Error GoTo Trap

    If index <= 0 And index > m_suppliers.Count Then
        Err.Raise ERROR_INVALID_INDEXING, "ReadWorksheet", "The indexer used in the arraw is out of bounds"
    End If

    GetSupplier = m_suppliers(index)

Leave:
    On Error GoTo 0
    Exit Function

Trap:
    HandleError Err.Description
    Resume Leave
End Function

Public Sub SetDispoCode(ByVal dispcode As Integer)
    On Error GoTo Trap

    If dispcode <= 0 And dispcode >= 1000 Then
        Err.Raise ERROR_INVALID_DISPOCODE, "ReadWorksheet", "The value must be between 1 (incl) and 999 (incl)"
    End If

    m_dispocode = dispcode

Leave:
    On Error GoTo 0
    Exit Sub

Trap:
    HandleError Err.Description
    Resume Leave
End Sub

Public Sub SetName(ByVal stringValue As String)
    On Error GoTo Trap

    If Len(Name) <= 3 Then
        Err.Raise ERROR_INVALID_NAME, "ReadWorksheet", "The name must be at least 3 letters long"
    End If

    m_name = Name

Leave:
    On Error GoTo 0
    Exit Sub

Trap:
    HandleError Err.Description
    Resume Leave
End Sub

Public Function GetMaterial(ByVal index As Integer) As String
    On Error GoTo Trap

    If index <= 0 And index > m_materials.Count Then
        Err.Raise ERROR_INVALID_INDEXING, "ReadWorksheet", "The indexer used in the arraw is out of bounds"
    End If

    GetMaterial = m_materials(index)

Leave:
    On Error GoTo 0
    Exit Function

Trap:
    HandleError Err.Description
    Resume Leave
End Function

Private Sub HandleError(ByVal message As String)
    If Not m_errorHandler Is Nothing Then m_errorHandler.ShowError message 
End Sub

'Called automatically when the class is created
Private Sub Class_Initialize()
      m_dispocode = 1
      m_name = "Unknown"
      Set m_suppliers = New Collection
      Set m_materials = New Collection
      SetID
End Sub

'Called automatically when the class is destroyed
Private Sub Class_Terminate()
    Set m_suppliers = Nothing
    Set m_materials = Nothing
    Set m_errorHandler = Nothing
End Sub

A simple error handler:

IErrorHandler

Option Explicit

Public Sub ShowError(ByVal message As String)
End Sub

ErrorHandler

Option Explicit
Implements IErrorHandler

Private Sub IErrorHandler_ShowError(ByVal message As String)
    MsgBox message, vbCritical, "Error"
End Sub

Testing:

Sub GenerateDisponents()

    Dim last_row As Long
    last_row = Sheets("Disponents").Cells(Rows.Count, 1).End(xlUp).Row

    Dim Dispos As New Collection
    Dim errHandler As IErrorHandler: Set errHandler = New ErrorHandler
    Dim Name As String
    Dim code As Integer
    Dim i As Long

    For i = 1 To last_row

        Dim temp As New Disponent
        temp.ErrorHandler = errHandler 

        Name = Sheets("Disponents").Range("B" & i).value
        code = Sheets("Disponents").Range("A" & i).value

        temp.SetName Name
        temp.SetDispoCode code

        Dispos.Add temp
    Next i


    MsgBox ("DONE")
End Sub