如何在VBA中循环类属性

Tho*_* My 4 oop vba class

我需要列出一个类的所有私有变量.就像是:

班级中的变量:

Dim varOne as String
Dim varTwo as Integer
Dim varThree as Date
Dim varFour as String
Run Code Online (Sandbox Code Playgroud)

Sub重新编译所有变量名称:

For Each classVariable In clsMyClass
     Msgbox classVariable.Name
Next
Run Code Online (Sandbox Code Playgroud)

结果:

varOne
varTwo
varThree
varFour
Run Code Online (Sandbox Code Playgroud)

我在这个论坛找到了解决方案,但仅适用于VB.NET,而不适用于VBA.无论如何我能在VBA中做到这一点吗?

提前致谢.


下面的代码有什么问题:

Private Sub btnTest_Click()
    Dim obj_Utilitario As cls_Utilitario
    Dim objColecao As Collection
    Dim item As Variant

    Set obj_Utilitario = New cls_Utilitario
    Set objColecao = obj_Utilitario.ColecaoForm(Me.Form)

    For Each item In objColecao
        MsgBox item.Name
    Next item

    Set objColecao = Nothing
End Sub
Run Code Online (Sandbox Code Playgroud)

这是cls_Utilitario类代码:

Public Function ColecaoForm(arg_form As Object) As Collection
    Dim colecao As Collection
    Dim campo As Control

    For Each campo In arg_form.Controls
        With campo
            Select Case .ControlType
                Case acComboBox, acTextBox
                    colecao.Add (.Object)
            End Select
        End With
    Next campo

    Set ColecaoForm = colecao

    Set colecao = Nothing
    Set campo = Nothing
    Set arg_form = Nothing
End Function
Run Code Online (Sandbox Code Playgroud)

当我删除Me.Form参数中下面的代码中的括号时:

Set objColecao = obj_Utilitario.ColecaoForm(Me.Form)
Run Code Online (Sandbox Code Playgroud)

它让我继续运行代码,但它显示运行时错误2455(无效引用...)现在是什么?任何的想法?

提前致谢.


到目前为止,这是cls_Ativo类代码:

Option Compare Database
Option Explicit

Private obj_Utilitario As New cls_Utilitario
Private col_Ativo As Collection

Private Const SQL As String = "SELECT tbl_Ativos.codigo_ativo, tbl_Ativos.especificacao FROM tbl_Ativos ORDER BY tbl_Ativos.codigo_ativo;"

Private Sub Class_Initialize()
    Dim registro As Recordset
    Dim campoRegistro As Field
    Dim i As Integer

    Set col_Ativo = New Collection

    Set registro = CurrentDb.OpenRecordset(SQL)

    If (Not (IsNull(registro)) And (registro.RecordCount > 0)) Then
        registro.MoveLast
        registro.MoveFirst

        For i = 0 To registro.Fields.Count - 1
            Set campoRegistro = registro.Fields(i)
            col_Ativo.Add campoRegistro, campoRegistro.SourceField
        Next i
    Else
        Set col_Ativo = Nothing
    End If

    Set registro = Nothing
    Set campoRegistro = Nothing
End Sub

Private Sub Class_Terminate()
    Set col_Ativo = Nothing
    Set obj_Utilitario = Nothing
End Sub

Public Property Get Campo(arg_Item As Variant) As Variant
    Campo = col_Ativo.item(arg_Item)
End Property

Public Property Let Campo(arg_Item As Variant, arg_Valor As Variant)
    Select Case arg_Item
        Case "codigo_ativo"
            If VarType(arg_Valor) = vbString Then
                If ValidaCodigoAtivo(arg_Valor) Then
                    col_Ativo.item(arg_Item) = arg_Valor
                Else
                    MsgBox "O código inserido não é válido."
                End If
            Else
                MsgBox "O código inserido não é um texto."
            End If

        Case "especificacao"
            If VarType(arg_Valor) = vbString Then
                col_Ativo.item(arg_Item) = arg_Valor
            Else
                MsgBox "A especificação inserida não é um texto válido."
            End If
    End Select
End Property
Run Code Online (Sandbox Code Playgroud)

这就是我想在表单模块中做的事情:

Private Sub btnTeste_Click()
    Dim obj_Ativo As cls_Ativo

    Set obj_Ativo = New cls_Ativo

    'Save a text into the collection item "especificacao" using Let property
    obj_Ativo.Campo ("especificacao","texto de exemplo, texto de exemplo...")

    'Return the collection item using Get property
    Msgbox obj_Ativo.Campo ("especificacao")

    Set obj_Ativo = Nothing
End Sub
Run Code Online (Sandbox Code Playgroud)

当我调用obj_Ativo.Campo时,它只允许我传递arg_Item作为参数并显示它不会返回任何值,就像它是一个Let属性一样.但如果它确实是一个Let属性,它应该允许我将第二个参数作为参数传递.

我想要的是在类中有一个集合对象,所有变量都有不同类型而不是私有变量.

提前致谢.

Tim*_*ams 5

除了大卫的建议,你还可以看看using CallByName:

Sub Tester()

Dim c As New clsTest

    c.one = 1
    c.two = "two"
    c.three = True

    Debug.Print "Before-----------"
    Debug.Print CallByName(c, "one", VbGet)
    Debug.Print CallByName(c, "two", VbGet)
    Debug.Print CallByName(c, "three", VbGet)

    CallByName c, "one", VbLet, 10
    CallByName c, "two", VbLet, "changed"
    CallByName c, "three", VbLet, False

    Debug.Print "After-----------"
    Debug.Print CallByName(c, "one", VbGet)
    Debug.Print CallByName(c, "two", VbGet)
    Debug.Print CallByName(c, "three", VbGet)

End Sub
Run Code Online (Sandbox Code Playgroud)

另clsTest:

Public one As Long
Public two As String
Public three As Boolean
Run Code Online (Sandbox Code Playgroud)

唯一需要注意的是你仍然无法直接检查clsTest实例的成员 - 它必须由表单上控件的名称驱动.