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 sub 时，我在 Let Materials 属性上收到以下错误： “同一属性的属性过程定义不一致，或属性过程有可选参数、ParamArray 或无效的 Set 最终参数。”

对于早期绑定，我使用以下参考：C:\Windows\Microsoft.NET\Framework\v4.0.30319.\mscorlib.dll。

你们知道我的代码为什么不起作用吗？

我确信它充满了错误，因为这是我第一次尝试在 VBA 中使用类。

提前感谢您的帮助！

Answer 1

Property Get Materials(indexof As Integer) As ArrayList 表示要返回 ArrayList，但 Property Let Materials(materialnum As String) 想要为其分配 string - 属性类型必须匹配。

作为一个数组支持这个属性obj.Materials = "Hello" 没有多大意义；你需要做 ArrayList 所做的事情并使用 .Add() / .Item() 方法。

是否有理由使用ArrayList 而不是内置类型之一？

Answer 2

试试这个：

一些注意事项：

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