Question

I have this class:

Option Explicit
Public Code As String
Public ArticleType As String
Public Division As String
Public Devise As String
Public GroupePrix As String
Property Get CodeOnly() As String
    CodeOnly = Replace(Code, "*", "")
End Property

And this function:

Function addFabricant(cod As String, art As String, div As String, dev As String, grp As String) As Fabricant
    Dim Fab As New Fabricant
    Fab.Code = cod
    Fab.ArticleType = art
    Fab.Division = div
    Fab.Devise = dev
    Fab.GroupePrix = grp
    Set addFabricant = Fab
End Function

And I want to do something like this:

Set Fabricants = New Collection
'This is where the code fail with error 438
Fabricants.Add (addFabricant("Code", "Sample", " ", "DogeCoin", "420"))
...

But it does not work. I'm new to VBA so I may be missing something.

I know that :

Set test = addFabricant("Code", "Sample", " ", "DogeCoin", "420")
Fabricants.Add (test)

is working, but it would add double the code to add all the Fabricant this way.

Answer 1

I think you want "user defined types"

Public Type MyType
   MyInt As Integer
   MyString As String
   MyDoubleArr(2) As Double
End Type

Then use it as a collection or an array.

Dim MyArr(2) As MyType

MyArr(0).MyInt = 31
MyArr(0).MyString = "VBA"
MyArr(0).MyDoubleArr(0) = 1
MyArr(0).MyDoubleArr(1) = 2
MyArr(0).MyDoubleArr(2) = 3
MyArr(1).MyInt = 32
MyArr(1).MyString = "is"
MyArr(1).MyDoubleArr(0) = 11
MyArr(1).MyDoubleArr(1) = 22
MyArr(1).MyDoubleArr(2) = 33
MyArr(2).MyInt = 33
MyArr(2).MyString = "cool"
MyArr(2).MyDoubleArr(0) = 111
MyArr(2).MyDoubleArr(1) = 222
MyArr(2).MyDoubleArr(2) = 333

Answer 2

I would create a wrapper class for your collection and add methods to the FabricantCollection to do what you want. Here is a FabricantCollection started for you:

Option Compare Database
Option Explicit

Private Const MODULE_NAME As String = "FabricantCollection"

Private m_oCollection As Collection

Private Sub Class_Initialize()
    Set m_oCollection = New Collection
End Sub

Private Sub Class_Terminate()
    If Not m_oCollection Is Nothing Then
        Set m_oCollection = Nothing
    End If
End Sub

Public Function Add(oFabricant As Fabricant) As Long
    m_oCollection.Add oFabricant, oFabricant.Code
    Add = m_oCollection.Count
End Function

Public Sub Clear()
    Set m_oCollection = New BaseCollection
End Sub

Public Property Get Count() As Long
    Count = m_oCollection.Count
End Property

Public Function Item(ByVal vKey As Variant) As Fabricant
    Set Item = m_oCollection.Item(vKey)
End Function

Public Function Remove(ByVal vKey As Variant) As Fabricant
    Set Remove = m_oCollection.Item(vKey)
    m_oCollection.Remove vKey
End Function

Public Function AddNew( _
        ByVal sCode As String, _
        ByVal sArt As String, _
        ByVal sDiv As String, _
        ByVal sDev As String, _
        ByVal sGrp As String) As Fabricant

    Dim oFabricant As Fabricant
    If Not oFabricant Is Nothing Then
        Err.Raise vbObjectError + 3334, MODULE_NAME & ".AddNew", "Item already exists with that key: " & sCode
        Exit Function
    End If

    Set oFabricant = New Fabricant

    With oFabricant
        .Code = sCode
        .ArticleType = sArt
        .Division = sDiv
        .Devise = sDev
        .GroupePrix = sGrp
    End With

    Add oFabricant

    Set AddNew = oFabricant

End Function

Public Property Get Fabricant( _
        ByVal sCode As String) As Variant

    Set Fabricant = m_oCollection.Item(sCode)

End Property

Add Class objects to Collection using a Function in VBA

2 个答案: