Discussion :

[bepbep]

Bonjour à tous,

Après plusieurs jours à tourner en rond, je me sens obliger de passer par ici pour trouver de l'aide sur mon problème.

Je souhaite intégrer en VBA dans une Collection de classe un grand nombre de données pour pouvoir les manipuler plus facilement par la suite.
On parle ici d'une feuille d'environ 100 x 100 qui doit être facilement modifiable ajout de colonnes ou de lignes.

Dans un soucis de propreté j'ai voulu utilisé des tableaux de 5 entrées pour environ 20 variables plutôt que d'en créer 100... Cependant en me basant sur différents guide comme ceux la :
http://tissotemmanuel.developpez.com...-de-classe/#LI
http://silkyroad.developpez.com/vba/tableaux/#LI

La feuille ou je récupère mes données comporte sur chaque ligne un Produit de différents éléments.
Chaque ligne de produit forme ma Collection de Produits

J'ai écrit 2 modules de classe:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
'--------------------------------'
'-Module de classe clsOISProduct-'
'--------------------------------'
Option Explicit
Option Base 1
 
Private mProvider As String
Private mProduct As String
Private mVersion As String
Private mCustomerPortal(1 To 5) As Long
'... je vous passe le nombre de variable pour plus de lisibilité
 
Property Get Provider() As String
    ' Propriété en lecture
    Provider = mProvider
End Property
 
Property Let Provider(NewProvider As String)
    ' Propriété en écriture
    mProvider = NewProvider
End Property
 
Property Get Product() As String
    ' Propriété en lecture
    Product = mProduct
End Property
 
Property Let Product(NewProduct As String)
    ' Propriété en écriture
    mProduct = NewProduct
End Property
 
Property Get Version() As String
    ' Propriété en lecture
    Version = mVersion
End Property
 
Property Let Version(NewVersion As String)
    ' Propriété en écriture
    mVersion = NewVersion
End Property
 
Property Get CustomerPortal() As Long
    ' Propriété en lecture
    CustomerPortal = mCustomerPortal                'Renvoie le tableau
End Property
 
Property Let CustomerPortal(ByRef NewCustomerPortal As Long)
    ' Propriété en écriture
    Dim i As Long
    'Vérification des caractéristiques de NewList (base et dimensions)
    For i = 0 To UBound(NewCustomerPortal)                                               'Validation
        If Not CheckItem(NewCustomerPortal(i)) Then
            Err.Raise vbObjectError + 1, , "Valeur incorrecte à l'indice " & i   'Erreur
        End If
    Next
    mCustomerPortal = NewCustomerPortal                        'Affectation du tableau
End Property
 
Property Let CustomerPortalItem(Index As Long, NewCustomerPortalItem As Long)
   If CheckItem(NewCustomerPortalItem) Then                                             'Validation
      mCustomerPortal(Index) = NewCustomerPortalItem                                             'Affectation
   Else
      Err.Raise vbObjectError + 1, , "Valeur incorrecte à l'indice " & Index  'Erreur
   End If
End Property
 
'... je vous passe l'ensemble des fonctions correspondant aux autres variables
 
Private Function CheckItem(Item As Long) As Boolean
   CheckItem = Item >= 0                  'Refuse les valeurs négatives
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
'----------------------------------'
'-Module de classe clsProductTable-'
'----------------------------------'
Option Explicit
 
Private Products As Collection                    'Déclare une collection
 
Private Sub Class_Initialize()
   Set Products = New Collection                  'Initialise la collection
End Sub
 
Function Count() As Long                           'Nombre d'éléments
   Count = Products.Count
End Function
 
Function Item(IndexOrName As Variant) As clsOISProduct    'Renvoi un élément
   Set Item = Products.Item(IndexOrName)
End Function
 
Sub Remove(IndexOrName As Variant)                 'Retire un élément
   Products.Remove IndexOrName
End Sub
 
Sub Add(Product As clsOISProduct)
    Products.Add Product                     'Ajouter un élément
End Sub

J'appelle ensuite une fonction d'initialisation dans une page quelconque.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Option Explicit
Option Base 1
 
'-----------------------------------------------------------'
'Fonction d'initialisation des données de la liste référence'
'-----------------------------------------------------------'
 
Sub InitDonnees()
Dim X As Integer, i As Long, j As Long, t As Variant, tmpTable() As Long
'Déclare un élément de type productOIS
Dim ProductTable As New clsProductTable
Dim OneProduct As clsOISProduct
 
'Identification du nombre de produits Cellule "NBProd" en CI2
t = Feuil3.Range("NBProd").Value
X = CInt(t)
 
'---------------Chargement du tableau-----------------'
'Remplit chaque élément avec les éléments de la feuil3'
For i = 1 To X
    ReDim tmpTable(1 To 5)
    Set OneProduct = New clsOISProduct
 
    OneProduct.Provider = Feuil3.Cells(i + 2, 1).Value
    OneProduct.Product = Feuil3.Cells(i + 2, 2).Value
    OneProduct.Version = Feuil3.Cells(i + 2, 3).Value
 
    For j = 1 To 5
    tmpTable(j) = CLng(Feuil3.Cells(i + 2, 3 + j).Value)
    OneProduct.CustomerPortalItem(j) = tmpTable(j)
    Next j
 
    '... je passe le remplissage de l'ensemble des données
 
    ProductTable.Add OneProduct
    Set OneProduct = Nothing
    Erase tmpTable()
Next i
'------------Fin Chargement du tableau----------------'
'-----------------------------------------------------'
 
'---- Affiche le résultat dans la fenêtre d'exécution -------
Debug.Print ProductTable.Item(1).Provider        'ok
Debug.Print ProductTable.Item(1).Product         'ok
Debug.Print ProductTable.Item(1).Version          'ok
Debug.Print ProductTable.Item(1).CustomerPortal        '[ko]
Debug.Print vbTab
 
End Sub

Mais je tombe sur une erreur "Incompatibilité de type" pour la récupération des données (au niveau du [ko]). Je l'ai tourné dans tous les sens sans succès. Impossible de récupérer les données stocker dans la classe dès que c'est un tableau.

Est-ce que quelqu'un as une idée?

[Invité]

Salut,

Je n'ai pas essayé ton/tes modules, mais essaye de remplacer
Property Let CustomerPortal(ByRef NewCustomerPortal As Long)
par
Property Let CustomerPortal(ByRef NewCustomerPortal() As Long)
pour voir ce que ça donne.

Sinon, pour la clareté du code.

[bepbep]

Salut Nouveau2,

Merci pour ta réponse.

Je viens de faire le test, si je modifie comme tu l'as proposé, ça ne fonctionne pas mieux même type d'erreur.

[Invité]

Salut,

Tu confirme qu'il n'y a pas d'erreur avant la ligne 45 du module basique (module n°3) ?
Sinon, je viens de voir que tu assigne un tableau à la messagebox en l'appelant. Le debug.print/messagebox ne gère pas les tableaux comme c'est le cas avec les range d'une feuille.
Essaye:

ProductTable.Item(1).CustomerPortal(1)

Cette erreur s'ajoute quoi qu'il en soit à d'éventuelles autres erreurs.
Si d'autres erreurs interviennent avant la ligne 45, je testerai tes modules pour voir.

A+

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Property Let CustomerPortal(ByRef NewCustomerPortal() As Long)

déclare ta propriété en public:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Property Let CustomerPortal(ByRef NewCustomerPortal() As Long)

on ne peut pas passer de tableau en VB:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public  Property Let CustomerPortal(ByRef NewCustomerPortal as Variant)

[bepbep]

Salut,

Tu confirme qu'il n'y a pas d'erreur avant la ligne 45 du module basique (module n°3) ?
Sinon, je viens de voir que tu assigne un tableau à la messagebox en l'appelant. Le debug.print/messagebox ne gère pas les tableaux comme c'est le cas avec les range d'une feuille.
Essaye:

ProductTable.Item(1).CustomerPortal(1)

Cette erreur s'ajoute quoi qu'il en soit à d'éventuelles autres erreurs.
Si d'autres erreurs interviennent avant la ligne 45, je testerai tes modules pour voir.

A+

Je confirme qu'avec le code du départ, il n'y a pas d'erreur, les informations sont bien stockés dans les différentes variables. Ceux sont des erreurs que j'ai eu tout au début que j'ai résolues mais j'en suis arrivé au point ou il m'est impossible des les récupérer des qu'elles sont dans des tableaux...
Ta 2ème proposition ne change pas la donne la récupération des données ne se fait plus : "Nombres d'arguments incorrects ou affectation de propriété impossible".

on ne peut pas passer de tableau en VB:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public  Property Let CustomerPortal(ByRef NewCustomerPortal as Variant)

Il n'y a pas vraiment de solution dans ce cas alors... Je vais devoir passer par une centaine de variables Moi qui voulait faire ça proprement pour une fois...

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
private toto() As Long
Public Property Get CustomerPortal()
 CustomerPortal = toto
End Property
Public Property Let CustomerPortal(p)
 toto = p
End Property
 
Sub test()
Dim a() As Long
ReDim a(10)
CustomerPortal = a
a = CustomerPortal
 
End Sub

[bepbep]

OK super rdurupt j'ai compris le principe. Merci beaucoup.

Je remets mon code avec la version qui fonctionne si ça peut aider d'autres personnes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
'--------------------------------'
'-Module de classe clsOISProduct-'
'--------------------------------'
Option Explicit
Option Base 1
 
Private mProvider As String
Private mProduct As String
Private mVersion As String
Private mCustomerPortal(1 To 5) As Long
'... je vous passe le nombre de variable pour plus de lisibilité
 
Public Property Get Provider() As String
    ' Propriété en lecture
    Provider = mProvider
End Property
 
Public Property Let Provider(NewProvider As String)
    ' Propriété en écriture
    mProvider = NewProvider
End Property
 
Public Property Get Product() As String
    ' Propriété en lecture
    Product = mProduct
End Property
 
Public Property Let Product(NewProduct As String)
    ' Propriété en écriture
    mProduct = NewProduct
End Property
 
Public Property Get Version() As String
    ' Propriété en lecture
    Version = mVersion
End Property
 
Public Property Let Version(NewVersion As String)
    ' Propriété en écriture
    mVersion = NewVersion
End Property
 
Public Property Get CustomerPortal()
    ' Propriété en lecture
    CustomerPortal = mCustomerPortal                'Renvoie le tableau
End Property
 
Public Property Let CustomerPortal(NewCustomerPortal)
    ' Propriété en écriture
    Dim i As Long
    'Vérification des caractéristiques de NewList (base et dimensions)
    For i = 0 To UBound(NewCustomerPortal)                                               'Validation
        If Not CheckItem(NewCustomerPortal(i)) Then
            Err.Raise vbObjectError + 1, , "Valeur incorrecte à l'indice " & i   'Erreur
        End If
    Next
    mCustomerPortal = NewCustomerPortal                        'Affectation du tableau
End Property
 
Public Property Let CustomerPortalItem(Index As Long, NewCustomerPortalItem As Long)
   If CheckItem(NewCustomerPortalItem) Then                                             'Validation
      mCustomerPortal(Index) = NewCustomerPortalItem                                             'Affectation
   Else
      Err.Raise vbObjectError + 1, , "Valeur incorrecte à l'indice " & Index  'Erreur
   End If
End Property
 
'... je vous passe l'ensemble des fonctions correspondant aux autres variables
 
Public Function CheckItem(Item As Long) As Boolean
   CheckItem = Item >= 0                  'Refuse les valeurs négatives
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
'----------------------------------'
'-Module de classe clsProductTable-'
'----------------------------------'
Option Explicit
 
Public Products As Collection                    'Déclare une collection
 
Public Sub Class_Initialize()
   Set Products = New Collection                  'Initialise la collection
End Sub
 
Function Count() As Long                           'Nombre d'éléments
   Count = Products.Count
End Function
 
Function Item(IndexOrName As Variant) As clsOISProduct    'Renvoi un élément
   Set Item = Products.Item(IndexOrName)
End Function
 
Sub Remove(IndexOrName As Variant)                 'Retire un élément
   Products.Remove IndexOrName
End Sub
 
Sub Add(Product As clsOISProduct)
    Products.Add Product                     'Ajouter un élément
End Sub

J'appelle ensuite une fonction d'initialisation dans une page quelconque.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Option Explicit
Option Base 1
 
'-----------------------------------------------------------'
'Fonction d'initialisation des données de la liste référence'
'-----------------------------------------------------------'
 
Sub InitDonnees()
Dim X As Integer, i As Long, j As Long, t As Variant, tmpTable() As Long
'Déclare un élément de type productOIS
Dim ProductTable As New clsProductTable
Dim OneProduct As clsOISProduct
 
'Identification du nombre de produits Cellule "NBProd" en CI2
t = Feuil3.Range("NBProd").Value
X = CInt(t)
 
'---------------Chargement du tableau-----------------'
'Remplit chaque élément avec les éléments de la feuil3'
For i = 1 To X
    ReDim tmpTable(1 To 5)
    Set OneProduct = New clsOISProduct
 
    OneProduct.Provider = Feuil3.Cells(i + 2, 1).Value
    OneProduct.Product = Feuil3.Cells(i + 2, 2).Value
    OneProduct.Version = Feuil3.Cells(i + 2, 3).Value
 
    For j = 1 To 5
    tmpTable(j) = CLng(Feuil3.Cells(i + 2, 3 + j).Value)
    OneProduct.CustomerPortalItem(j) = tmpTable(j)
    Next j
 
    '... je passe le remplissage de l'ensemble des données
 
    ProductTable.Add OneProduct
    Set OneProduct = Nothing
    Erase tmpTable()
Next i
'------------Fin Chargement du tableau----------------'
'-----------------------------------------------------'
 
'---- Affiche le résultat dans la fenêtre d'exécution -------
Debug.Print ProductTable.Item(1).Provider        'ok
Debug.Print ProductTable.Item(1).Product         'ok
Debug.Print ProductTable.Item(1).Version          'ok
Debug.Print ProductTable.Item(1).CustomerPortal(1)        'ok
Debug.Print vbTab
 
End Sub

[Invité]

on ne peut pas passer de tableau en VB:

C'est bon à savoir ça.
Mais ça ne s'adresse qu'aux propriété Let/Get/Set ?

[Invité]

non au sub et au fonction:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
sub test(Table() as long) 'interdit
function teste2(Table() as long) as string 'interdit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
'si tu déclares un variant le tableau passe.
sub test(Table as Variant) 'OK
function teste2(Table as Variant) as string 'OK
 
function teste2() 
teste2=array(1,2,3,4,5,6) 'OK

[Invité]

Il n'y a pas vraiment de solution dans ce cas alors... Je vais devoir passer par une centaine de variables Moi qui voulait faire ça proprement pour une fois...

Tu veux ajouter des Item à une collection ?

Je commence tout juste les modules de classe, mais voilà comment je fais depuis recemment (moins d'une semaine):

Module de classe (Fonction pour accepter des array):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Function AddFromArray(ByVal Names_String, Optional ByVal Rates_Double, Optional ByVal HoursPerWeeks_Double, Optional ByVal Temporaires_Boolean) As C2Employees
    Dim i As Long
    Dim clsEmployee As C2Employee
 
    For i = LBound(Names_String) To UBound(Names_String)
        Set clsEmployee = New C2Employee
        With clsEmployee
            .Name = Names_String(i)
            .Rate = Rates_Double(i)
            .HoursPerWeek = HoursPerWeeks_Double(i)
            .Index = Me.Count + 1
            .Key = ObjPtr(clsEmployee)
            mcolEmployees.Add clsEmployee, CStr(.Key)
        End With
        Set clsEmployee = Nothing
    Next i
 
End Function

Module Basique:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Global clsEmployees As C2Employees 'liaison anticipée 'Ou Private/Public
Sub AddEmployees()
    Dim vNames
    Dim vRates
    Dim vHours
    Dim vTemps
 
    vNames = Array("Mary", "Jack", "Anne", "Harry")
    vRates = Array(15, 14, 20, 17)
    vHours = Array(45, 35, 40, 40)
    vTemps = Array(True, True, True, True) 'Pas encore utilisé
 
    Set clsEmployees = New C2Employees
    clsEmployees.AddFromArray vNames, vRates, vHours, vTemps
End Sub

[Invité]

on est bien d'accord tes variable ne sont pas typées ce qui revient à dire as Variant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ByVal Names_String 'pas de type,

[Invité]

Et comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Table(1 To 5) As Long
 
Sub test(ByRef Table() As Long) 'interdit
 MsgBox "Est passé " & Table(4)
End Sub
 
Sub Lanceur()
    Table(1) = 1
    Table(4) = 3
    test Table()
End Sub

on est bien d'accord tes variable ne sont pas typées ce qui revient à dire as Variant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ByVal Names_String 'pas de type,

Oui, c'est parce que le "Array" attribue automatiquement un type Variant.
Il est plus simple d'écrire une array en ligne avec le mot clé "Array" (en tout cas, je trouve), mais sinon:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
    Dim vNames
    Dim vNames2(0 To 3) As String
    Dim vRates
    Dim vHours
    Dim vTemps
 
    vNames = Array("Mary", "Jack", "Anne", "Harry")
    vNames2(0) = "Mary"
    vNames2(1) = "Jack"
    vNames2(2) = "Anne"
    vNames2(3) = "Harry"

puis remplacer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

clsEmployees.AddFromArray vNames2, vRates, vHours, vTemps

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public Function AddFromArray(ByRef Names_String() As String, Optional ByVal Rates_Double, Optional ByVal HoursPerWeeks_Double, Optional ByVal Temporaires_Boolean) As C2Employees

Je viens de tester, ça marche

[Invité]

Et comme ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Table(1 To 5) As Long
 
Sub test(ByRef Table() As Long) 'interdit
 MsgBox "Est passé " & Table(4)
End Sub
 
Sub Lanceur()
    Table(1) = 1
    Table(4) = 3
    test Table()
End Sub

je m'incline!

[Invité]

Il y a un cas où les Object ne passe pas avec les tableaux, c'est pour ça que je pensais que peut être il y aurai pu y avoir un problème avec les propriétés, c'est quand tu définis un tableau imbriqué en escalier. Avec les objects, ça ne marche pas.

Du moins, je n'ai jamais réussi en tout cas.

Mais bon, c'est plus pratique avec un type Variant de toute façon ne serait-ce que pour écrire directement les données en lignes séparé par une simple virgule.

[Invité]

en tout cas ne pas typer les variables passées en paramètre ça mange pas de pain!! si on sais quoi faire derrière.

[Invité]

Oui, exactement.
C'est pour ça que j'ai rajouter les types de données après les noms, c'est un des problèmes du type Variant, savoir reconnaitre quoi mettre comme type.

A+