Discussion :

[zilly]

Bonjour,
24h et je sèche toujours. Cela va sauter aux yeux de quelqu'un mais pas des miens visiblement ...

L'erreur 91 est générée à la ligne 19 du module de test juste après avoir récupéré objColonne.Desc (Classe Colonnes - l10)

classe Colonne

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
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
 
'Sert à créer une collection contenant chaque élément avec :
Private mCol As Integer   'Le n° de colonne
Private mDescription As String   'Le nom
Private mAlias As Collection  'Les noms équivalents
 
Private Sub Class_Initialize()
    Set mAlias = New Collection
End Sub
 
Private Sub Class_Terminate()
    If Not (mAlias Is Nothing) Then Set mAlias = Nothing
End Sub
 
Property Let Col(IntCol As Integer)
    If IntCol <= 0 Then
        Err.Raise 512 + 3, "Classe Colonne", "Un numéro de colonne doit être > 0."
        Exit Property
    Else
        mCol = IntCol
    End If
End Property
 
Property Get Col() As Integer
    Col = mCol
End Property
 
Property Let Desc(ByVal StrDesc As String)
    If StrDesc <> "" Then
        mDescription = StrDesc
    Else
        Err.Raise 512 + 4, "Classe Colonne", "Un descriptif ne peut être vide."
    End If
End Property
 
Property Get Desc() As String
    Desc = mDescription
End Property
 
Property Let Alias(ByRef ListAlias As Collection)
    Dim StrDescAlias As Variant 'String
    For Each StrDescAlias In ListAlias
        If TypeName(StrDescAlias) <> "String" Then
            Err.Raise 512 + 5, "Classe Colonne", "Type de donnée incompatible avec un alias."
        ElseIf StrDescAlias = "" Then
            Err.Raise 512 + 4, "Classe Colonne", "Un alias ne peut être vide."
        End If
    Next StrDescAlias
    Set mAlias = ListAlias
End Property
 
Property Get Alias() As Collection
    Set Alias = mAlias
End Property
 
Sub AddAlias(ByVal Alias As String)
    If Alias <> "" Then
        mAlias.Add Alias
    Else
        Err.Raise 512 + 4, "Classe Colonne", "Un Alias ne peut être vide."
    End If
End Sub
 
Sub RemoveAlias(Optional ByRef Index As Variant)
    Dim i As Integer
    Dim error As Boolean
 
    If Index Is Nothing Then
        Set mAlias = Nothing
    Else
        If TypeName(Index) = "Integer" Then
            mAlias.Remove Index
        ElseIf TypeName(Index) = "String" Then
            error = True
            For i = 1 To mAlias.Count
                If mAlias(i) = Index Then
                    mAlias.Remove (i)
                    error = False
            Next i
            If error Then Err.Raise 512 + 7, "Classe Colonne", "Alias non trouvé."
        Else
            Err.Raise 512 + 6, "Classe Colonne", "Type de donnée incompatible."
        End If
    End If
End Sub

Classe Colonnes

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
Option Explicit
 
Private listeColonnes As Collection
 
Property Get Count() As Long
    Count = listeColonnes.Count
End Property
 
Public Sub Add(ByRef objColonne As Colonne)
    listeColonnes.Add objColonne, objColonne.Desc
    Debug.Print "added"
End Sub
 
Public Sub Remove(ByVal Index As Variant)
    Set listeColonnes(Index) = Nothing 'Non testé
    listeColonnes.Remove Index
End Sub
 
Public Function Item(ByVal Index As Variant) As Colonne
    Dim TestColonne As Variant 'Colonne
    Dim Alias As Variant 'String
    On Error GoTo Poursuite
    Set Item = listeColonnes(Index)
    Exit Function
Poursuite:
    For Each TestColonne In listeColonnes
        For Each Alias In TestColonne.Alias()
            If Alias = Index Then Set Item = TestColonne
            Exit For
        Next Alias
    Next TestColonne
    If TestColonne Is Nothing Then Err.Raise 512 + 2, , "Index en dehors de la sélection" & vbCrLf & Index
 
    Set TestColonne = Nothing
End Function

Module de test

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
Option Explicit
 
Sub t()
    Dim ListCol As Colonnes
    Dim Col As Colonne
    Dim i As Variant
    Dim Aliass As Collection
    Dim Alias As Variant
 
    Set ListCol = New Colonnes
    For Each i In Array(1, 2)
        Set Col = New Colonne
        Set Aliass = New Collection
        Col.Col = i
        Col.Desc = "Col" & i
        Aliass.Add "Col" & i * 10
        Aliass.Add "Col" & i * 100
        Col.Alias = Aliass
        ListCol.Add Col
    Next i
    ListCol.Item(2).AddAlias "Col" & Str(2000)
 
    For Each i In Array(1, 2)
        Debug.Print ListCol.Item(i).Desc & " : " & ListCol.Item(i).Col
        For Each Alias In ListCol.Item(i).Alias
            Debug.Print "  Alias" & Alias
        Next Alias
    Next i
End Sub

[zilly]

Bien sûr c'était évident : Il manque une initialisation ...

Code :

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

1
2
3
Private Sub Class_Initialize()
    Set listeColonnes = New Collection
End Sub