VBA Первый раз создавая Класс

Question

Я сейчас работаю над проектом VBA. У меня есть только опыт работы с основами VBA (нет OOP, только функции и сабвуферы) и C#.

Сегодня я пытаюсь создать свой первый класс, но я сталкиваюсь с ошибкой.

Вот так выглядит класс:

'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

И вот как я пытаюсь создать свои объекты в SUB в обычном модуле:

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

Когда я пытаюсь чтобы запустить подпрограмму GenerateDisponents, я получаю следующую ошибку в свойстве Let Materials: «Определения процедур свойства для одного и того же свойства противоречивы, или процедура свойства имеет необязательный параметр, ParamArray или недопустимый конечный параметр Set.»

Для раннего связывания я использую следующую ссылку: C: \ Windows \ Microsoft.NET \ Framework \ v4.0.30319. \ Mscorlib.dll.

Ребята, вы понимаете, почему мой код не не работает?

Я уверен, что в нем много ошибок, потому что я впервые пытаюсь использовать классы в VBA.

Заранее спасибо за помощь!

Answer 1

Попробуйте это:

Несколько замечаний:

1) Свойства не должны вызывать ошибок. Если вам нужно вызвать ошибку, измените свойство на метод.

2) Я бы хотел сказать «введено», но это неточно, поэтому я установил IErrorHandler через свойство для обработки ошибок в класс. Вы можете изменить его на метод, например, Init(ByVal objHandler as IErrorHandler) или обрабатывать их так, как вам нравится, но, пожалуйста, не показывайте окна сообщений через класс.

3) Наконец, я изменил ArrayList на Collection.

Класс Disponent:

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

Простой обработчик ошибок:

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

Тестирование:

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

Answer 2

Property Get Materials(indexof As Integer) As ArrayList говорит, что ArrayList должен быть возвращен, но Property Let Materials(materialnum As String) хочет, чтобы ему было присвоено string - типы свойств должны совпадать.

Поскольку массив поддерживает это свойство obj.Materials = "Hello" не имеет особого смысла; вам нужно сделать то, что ArrayList использует .Add() / .Item() методы.

Есть ли причина для использования ArrayList вместо одного из встроенных типов?