Problème dans un module de classe en VBA

Question

Bonjour tout le monde.
Je d&#233;bute avec les modules de classes en vba et je suis confront&#233; &#224; un probl&#232;me.
Mon code est compos&#233; de 2 modules de classes et d'un module qui fait appel &#224; ces modules de classe.

Le probl&#232;me est le suivant:
J'instancie mesModeles et je lui ajoute une instance de monModele avec la methode addModele(m as monModele). Par la suite je cherche a r&#233;cup&#233;rer cet objet avec la methode getModele( i as integer) de mesModeles, mais cela ne fonctionne pas.
J'ai test&#233; un peu tout, donc si quelqu'un pouvait me donner un pti coup de pouce.
merci d'avance.

Tom

-------
module 
-------

Public mon As New monModele
Public mon2 As New monModele
Public mes As New mesModeles


Public Sub init()
mon.setA 3
mon.setBeta 4
mon.setNom "test"
mon.setTxMarque 10
mon.setTxModele 20
mon.setTxParticulier 30
mon.setTxSegment 40
mon.afficher


Debug.Print "mon:"
mes.addModele mon


Set mon2 = mes.getModele(0)


Debug.Print "mon2:"
mon2.afficher


End Sub

-------------
MonModele
-------------

Private nom As String
Private modele As modele
Private rng As Range
Private a As Integer
Private beta As Integer
Private volumes As Variant
Private lois As Variant
Private tailleVolumes As Integer
Private tailleLois As Integer


Private Sub Class_Initialize()
tailleVolumes = 0
tailleLois = 0
End Sub


Public Function getNom() As String
getNom = nom
End Function


Public Sub setNom(n As String)
nom = n
End Sub


Public Function getRng() As Range
getRng = rng
End Function


Public Sub setRng(rng1 As Range)
Set rng = rng1
End Sub


Public Function getA() As Integer
getA = a
End Function


Public Sub setA(a1 As Integer)
a = a1
End Sub


Public Function getBeta() As Integer
getBeta = beta
End Function


Public Sub setBeta(Beta1 As Integer)
beta = Beta1
End Sub


Public Function getTxParticulier() As Double
getTxParticulier = modele.txParticulier
End Function


Public Function setTxParticulier(t As Double)
modele.txParticulier = t
End Function


Public Function getTxSegment() As Double
getTxSegment = modele.txSegment
End Function


Public Function setTxSegment(t As Double)
modele.txSegment = t
End Function


Public Function getTxMarque() As Double
getTxMarque = modele.txMarque
End Function


Public Function setTxMarque(t As Double)
modele.txMarque = t
End Function


Public Function getTxModele() As Double
getTxModele = modele.txModele
End Function


Public Function setTxModele(t As Double)
modele.txModele = t
End Function


Public Function getVolumes() As Variant
getVolumes = volumes
End Function


Public Sub setVolumes(v As Variant)
volumes = v
tailleVolumes = UBound(volumes) - LBound(volumes)
End Sub


Public Function getLois() As Variant
getLois = lois
End Function


Public Sub setLois(l As Variant)
lois = l
tailleLois = UBound(lois) - LBound(lois)
End Sub


Public Sub afficher()
Debug.Print "------------------------------------------------"
Debug.Print nom
Debug.Print "................................................."
'Debug.Print "Range=" & rng.Address
Debug.Print "txParticulier=" & modele.txParticulier
Debug.Print "txSegment=" & modele.txSegment
Debug.Print "txMarque=" & modele.txMarque
Debug.Print "txModele=" & modele.txModele
Debug.Print "a=" & a
Debug.Print "beta=" & beta
Debug.Print "------------------------------------------------"
End Sub


Private Sub Class_Terminate()
End Sub

-------------
mesModeles
-------------

Private nbModeles As Integer
Private modeles() As New monModele
Private volumes As Variant
Private lois As Variant
Private tailleMax As Integer


Private Sub Class_Initialize()
nbModeles = 0
End Sub


Public Function getNbModeles() As Integer
getNbModeles = nbModeles
End Function


Public Function getModele(k As Integer) As monModele
getModele = modeles(k)
End Function


Public Sub addModele(m As monModele)
If Not m Is Nothing Then
    nbModeles = nbModeles + 1
    ReDim Preserve modeles(nbModeles)

    Set modeles(nbModeles - 1) = m
    
    If Module2.debuged Then
        Debug.Print "modele ajout&#233; a mesModeles"
        Debug.Print "nbModeles=" & nbModeles
        Debug.Print "modeles(" & nbModeles - 1&; ") :"
        modeles(nbModeles - 1).afficher
    End If
End If
End Sub


Private Sub Class_Terminate()
Set modeles = Nothing
End Sub

cs_TomC · Answer

y'a quelqu'un ? :)
Je suis en gal&#232;re s&#233;v&#232;re...

kalobit · Answer

salut,

visiblement, tu n'utilise pas les syntaxes de module de classe mais &#231;a ne semble pas &#234;tre la source de ton probl&#232;me.

Si j'ai bien compris, tu utilise deux classes Modeles et modele.

En toute logique, la classe modeles est une collection d'objets de classe modele.

Pour bien faire, il faudrait que ta classe modeles soit une classe collection.

Pour &#231;a, tu d&#233;clare une collection priv&#233;e dans modeles.

Ensuite tu code les propri&#233;t&#233;s et m&#233;thodes d'une collection dans cette classe en utilisant les instruction s suivantes :

property get
property let
et property set

Voici un exemple de classe collection :

ici, il s'agit d'une collection d'objet immeule, correspondant &#224; une autre classe

' d&#233;claration de la collection
Private Immcol As Collection


Public Function Add(Imm As Immeuble, Optional sKey As String) As Immeuble
'Ajoute l'op&#233;ration &#224; la collection


If Len(sKey) = 0 Then
Immcol.Add Imm, Imm.Nom
Else
Immcol.Add Imm, sKey
End If


'renvoyer l'objet cr&#233;&#233;
Set Add = Imm
make_moyenne
End Function


Public Property Get Item(vntIndexKey As Variant) As Immeuble
'renvoie une op&#233;ration de la collection
Set Item = Immcol(vntIndexKey)
End Property


Public Property Get Count() As Long
'utilis&#233;e pour lire le nombre d'&#233;l&#233;ments dans la collection.
Count = Immcol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
'utilis&#233;e lors de la suppression d'un &#233;l&#233;ment de la collection
'vntIndexKey contient l'index ou la cl&#233;, il est donc
'd&#233;clar&#233; en tant que Variant
Immcol.Remove vntIndexKey
End Sub


Private Sub Class_Initialize()
'Cr&#233;e la collection lorsque cette classe est cr&#233;&#233;e
Set Immcol = New Collection
End Sub


Private Sub Class_Terminate()
'D&#233;truit la collection lorsque cette classe est d&#233;truite
Set Immcol = Nothing
End Sub
   
Voil&#224;, bon courage &#224; toi
et n'h&#233;site pas si tu &#224; encore des questions

++++ [mailto:K@lobit K@lobit]

cs_TomC · Answer

Oui, je viens de d&#233;couvrir ce matin les get let et set :-D


Et puis j'&#233;tais justement en train de changer mon tableau en une collection (d&#233;cidemment ac fait beaucoup de coincidences :) )


En tout cas un grand merci &#224; toi pour ta r&#233;ponse qui va me permetter d'avancer beaucoup plus vite. Bonne journ&#233;e

cs_TomC · Answer

Je n'arriva pas &#224; valider ta r&#233;ponse en cliquant sur r&#233;ponse accept&#233;... il doit y avoir un probl&#232;me. Je reessayerai plus tard
;)

Problème dans un module de classe en VBA

4 réponses

Discussions similaires