Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to Loop Through Class Attributes in VBA

Tags:

oop

class

vba

I need to list all the private variables of a class. something like:

Variables in the class:

Dim varOne as String
Dim varTwo as Integer
Dim varThree as Date
Dim varFour as String

Sub that retruns all the variable names:

For Each classVariable In clsMyClass
     Msgbox classVariable.Name
Next

Result:

varOne
varTwo
varThree
varFour

I found the solution in this forum but only for VB.NET, not for VBA. is there anyway I can do this in VBA?

thanks in advance.


what's the problem with the code below:

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

this is the cls_Utilitario class code:

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

when I remove the parentheses in the folowing code in the Me.Form argument:

Set objColecao = obj_Utilitario.ColecaoForm(Me.Form)

it lets me keep on running the code but it shows runtime error 2455 (invalid reference...) what now? any idea?

thanks in advance.


this is the cls_Ativo class code so far:

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

and this is what i want to do in the form module:

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

when i call obj_Ativo.Campo, it just allows me to pass arg_Item as parameter and shows that it will not return any value, as if it were a Let property. but if it were a Let property indeed, it should allow me to pass the second argument as parameter.

what i want is to have a collection object in the class with all the variables with different types instead of private variables.

thanks in advance.

like image 379
Thor My Avatar asked Mar 19 '23 17:03

Thor My


2 Answers

In addition to David's suggestion, you can also look into 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

clsTest:

Public one As Long
Public two As String
Public three As Boolean

The only thing to note is you still can't examine directly the members of an instance of clsTest - it would have to be driven by the names of the controls on the form.

like image 135
Tim Williams Avatar answered Mar 30 '23 07:03

Tim Williams


To your second question, I think you do not have to pass whole Form. It will be ok if you pass Controls only.

Set objColecao = obj_Utilitario.ColecaoForm(Me.Controls)

Then in the function do not forget to initialize the Collection object with 'New' keyword.

Public Function ColecaoForm(arg_form_controls As Controls) As Collection
    Dim campo As Control

    Set ColecaoForm = New Collection

    For Each campo In arg_form_controls
        If campo.ControlType = acComboBox Or _
           campo.ControlType = acTextBox Then
            ColecaoForm.Add campo
        End If
    Next campo
End Function
like image 40
Daniel Dušek Avatar answered Mar 30 '23 06:03

Daniel Dušek