Module de classe - Liens de parentés entre classes

**StarFalco** · 18/10/2018, 19h38

Bonjour à tous,

Il s'agit de mon premier poste mais d'une nième consultation de cet ecxellent forum.
J'ai ici une classe "Label" qui parmi ses attributs on y trouve "Position", correspondant à la colonne où se situe ce Label (soit un libellé) dans un objet type Tableau ou Worksheet. Cela dit, j'ai également une classe "TabData" qui n'est autre qu'une classe faisant référence à un objet type Tableau ou Worksheet mais qui possède un attribut "LabelsDict" qui est un dictionnaire contenant tout les Label qui y figurent. Enfin une dernière classe "TabDatas" me sert à répertorier toutes les classes TabData lui concernant via l'attribut "TabDatasDict".

Mon objectif est de pouvoir attribuer à chaque libellé (LabelA, LabelB...), de chacune des feuilles 1 et 2, un indice colonne selon sa TabData, voici un exemple pour appeler la position du LabelA, de la TabData "Feuil1" (correspondant dans le dictionnaire TabDataList à TabDataList(1)), de la TabDatas "Classeur1":

Code :

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

Classeur1.TabDatasList(1).LabelsList(LabelA).Position

Je suis certain que mon explication sera peu clair, je vous laisse donc en pièce jointe ce que j'ai tenté pour le moment. Si vous lancez la sub "DefinirPositionLabels" dans le module "Tests", vous verrai sur la console d'exécution qu'on obtient la "Position" pour "LabelA" que se soit sur Feuil1 ou Feuil2 (soit 3), ce qui n'est pas le résultat attendu

:

Code :

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

1
2
Debug.Print Classeur1.TabDatasList(1).WkSheet.Name & " " & Classeur1.TabDatasList(1).LabelsList(LabelA).Name & " " & Classeur1.TabDatasList(1).LabelsList(LabelA).Position
Debug.Print Classeur1.TabDatasList(2).WkSheet.Name & " " & Classeur1.TabDatasList(2).LabelsList(LabelA).Name & " " & Classeur1.TabDatasList(2).LabelsList(LabelA).Position

Console d'exécution:

Code :

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

1
2
Feuil1 LabelA 3
Feuil2 LabelA 3

Auriez vous des pistes

?

Merci à vous tous!

PS: Je me suis aidé dans un premier temps du code de dysorthographie (un grand merci btw!), https://www.developpez.net/forums/d1...buts-d-classe/

Les différents modules, sub et classes :

1. Module "Tests"
> Déclarations

Code :

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

1
2
3
Public LabelA  As New Label, LabelB As New Label, LabelC As New Label, LabelD As New Label, LabelE As New Label, LabelF As New Label
Public Feuil1 As New TabData, Feuil2 As New TabData
Public Classeur1 As New TabDatas

> Sub DefinirPositionLabels()

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
Sub DefinirPositionLabels()
 
Dim i As Byte, j As Byte
 
    'Initialisation de la classe TabDatas - Classeur1 - stockant tout les TabData - Feuil1 et Feuil2
    Set Classeur1.AddTabData(Feuil1) = Feuil1
    Set Classeur1.AddTabData(Feuil2) = Feuil2
 
    'Initialisation des classes TabData - Feuil1 et Feuil2 - stockant les label les presents
    Set Feuil1.WkSheet = ThisWorkbook.Worksheets(1)
 
    Set Feuil2.WkSheet = ThisWorkbook.Worksheets(2)
 
    Set Feuil1.AddLabel(LabelA) = LabelA
    Set Feuil1.AddLabel(LabelB) = LabelB
    Set Feuil1.AddLabel(LabelC) = LabelC
    Set Feuil1.AddLabel(LabelD) = LabelD
    Set Feuil1.AddLabel(LabelE) = LabelE
    Set Feuil1.AddLabel(LabelF) = LabelF
 
    Set Feuil2.AddLabel(LabelA) = LabelA
    Set Feuil2.AddLabel(LabelB) = LabelB
    Set Feuil2.AddLabel(LabelC) = LabelC
    Set Feuil2.AddLabel(LabelF) = LabelF
 
    'Initialisation des classes Label - nous aurons ici besoin que de leur attributs Name
    LabelA.Name = "LabelA"
    LabelB.Name = "LabelB"
    LabelC.Name = "LabelC"
    LabelD.Name = "LabelD"
    LabelE.Name = "LabelE"
    LabelF.Name = "LabelF"
 
    'Boucle pour definir l'attribut Position de chaque Label selon sa TabData correspondante
    For i = 1 To Classeur1.NbTabDatas
 
        For j = 1 To Classeur1.TabDatasList(i).NbLabels
 
            Set Classeur1.TabDatasList(i).LabelsList(j).WkSheet = Classeur1.TabDatasList(i).WkSheet
            Classeur1.TabDatasList(i).LabelsList(j).Position = Application.Match(Classeur1.TabDatasList(i).LabelsList(j).Name, Classeur1.TabDatasList(i).WkSheet.Rows(1), 0) 'On suppose que chaque label sont en ligne 1
 
            'Debug.Print Classeur1.TabDatasList(i).WkSheet.Name & " " & Classeur1.TabDatasList(i).LabelsList(j).Name & " " & Classeur1.TabDatasList(i).LabelsList(j).Position
 
        Next j
 
    Next i
 
    'Tests
    Debug.Print Classeur1.TabDatasList(1).WkSheet.Name & " " & Classeur1.TabDatasList(1).LabelsList(LabelA).Name & " " & Classeur1.TabDatasList(1).LabelsList(LabelA).Position
    Debug.Print Classeur1.TabDatasList(2).WkSheet.Name & " " & Classeur1.TabDatasList(2).LabelsList(LabelA).Name & " " & Classeur1.TabDatasList(2).LabelsList(LabelA).Position
 
End Sub

2. Classes
> Label

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
Private MeName As String
Private MePosition As Integer
Private MeTabData As TabData
Private MeWkSheet As Worksheet
 
Property Get Name() As String
    ' Propriété en lecture
    Name = MeName
End Property
Property Let Name(Name As String)
    ' Propriété en écriture
    MeName = Name
End Property
 
Property Get Position() As Integer
    ' Propriété en lecture
    Position = MePosition
End Property
Property Let Position(Position As Integer)
    ' Propriété en écriture
    MePosition = Position
End Property
 
Property Let RowIndex(RowIndex As Byte)
    ' Propriété en écriture
    MeRowIndex = RowIndex
End Property
 
Property Get TabData() As TabData
    ' Propriété en lecture
    Set TabData = MeTabData
End Property
Property Set TabData(TabData As TabData)
    ' Propriété en écriture
    Set MeTabData = TabData
End Property
 
Property Get WkSheet() As Worksheet
    ' Propriété en lecture
    Set WkSheet = MeWkSheet
End Property
Property Set WkSheet(WkSheet As Worksheet)
    ' Propriété en écriture
    Set MeWkSheet = WkSheet
End Property

> TabData

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Private MeBook As Workbook
Private MeWkSheet As Worksheet
Private MeLabelsRowIndex As Byte
Private MeDirectory As String
Private MeBookName As String
Private MeSheetName As String
Private MeFolderType As String
Private LabelsDict As Object
 
Private Sub Class_Initialize()
    Set LabelsDict = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
    Set LabelsDict = Nothing
End Sub
 
Public Property Set AddLabel(TheNewLabel As Label, LabelToAdd As Label)
    ' Propriété en écriture
    k = LabelsDict.Keys
    Set LabelsDict(TheNewLabel) = LabelToAdd
End Property
Public Property Get LabelsList(LabelIndex) As Label
    ' Propriété en lecture
    k = LabelsDict.Keys
    If IsNumeric(LabelIndex) Then Set LabelsList = LabelsDict(k(LabelIndex - 1)) Else Set LabelsList = LabelsDict(LabelIndex)
End Property
 
Public Property Get NbLabels() As Byte
    ' Propriété en lecture
    NbLabels = LabelsDict.Count
End Property
 
Property Get Book() As Workbook
    ' Propriété en lecture
    Set Book = MeBook
End Property
Property Set Book(Book As Workbook)
    ' Propriété en écriture
    Set MeBook = Book
End Property
 
Property Get WkSheet() As Worksheet
    ' Propriété en lecture
    Set WkSheet = MeWkSheet
End Property
Property Set WkSheet(WkSheet As Worksheet)
    ' Propriété en écriture
    Set MeWkSheet = WkSheet
End Property
 
Property Let LabelsRowIndex(LabelsRowIndex As Byte)
    ' Propriété en écriture
    MeLabelsRowIndex = LabelsRowIndex
End Property
Property Get LabelsRowIndex() As Byte
    ' Propriété en lecture
    LabelsRowIndex = MeLabelsRowIndex
End Property
 
Property Get Directory() As String
    ' Propriété en lecture
    Directory = MeDirectory
End Property
Property Let Directory(Directory As String)
    ' Propriété en écriture
    MeDirectory = Directory
End Property
 
Property Get BookName() As String
    ' Propriété en lecture
    BookName = MeBookName
End Property
Property Let BookName(BookName As String)
    ' Propriété en écriture
    MeBookName = BookName
End Property
 
Property Get SheetName() As String
    ' Propriété en lecture
    SheetName = MeSheetName
End Property
Property Let SheetName(SheetName As String)
    ' Propriété en écriture
    MeSheetName = SheetName
End Property
 
Property Get FolderType() As String
    ' Propriété en lecture
    FolderType = MeFolderType
End Property
Property Let FolderType(FolderType As String)
    ' Propriété en écriture
    MeFolderType = FolderType
End Property
 
Property Get FullName() As String
    ' Propriété en lecture
    FullName = Directory & "\" & BookName & "." & FolderType
End Property
 
Property Get nbRows() As Integer
    ' Propriété en lecture
    nbRows = WkSheet.Cells(Rows.Count, 2).End(xlUp).Row
End Property
 
Property Get nbColumns() As Integer
    ' Propriété en lecture
    nbColumns = WkSheet.Cells(LabelsRowIndex, Columns.Count).End(xlToLeft).Column
End Property
 
Property Get Matrix() As Variant
    ' Propriété en lecture
    Matrix = WkSheet.Range(WkSheet.Cells(LabelsRowIndex, 1), WkSheet.Cells(nbRows, nbColumns)).Value
End Property

> TabDatas

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
Private TabDatasDict As Object
 
Private Sub Class_Initialize()
    Set TabDatasDict = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
    Set TabDatasDict = Nothing
End Sub
 
Public Property Set AddTabData(TheNewTabData As TabData, TabDataToAdd As TabData)
    ' Propriété en écriture
    k = TabDatasDict.Keys
    Set TabDatasDict(TheNewTabData) = TabDataToAdd
End Property
Public Property Get TabDatasList(TabDataIndex As Byte) As TabData
    ' Propriété en lecture
    k = TabDatasDict.Keys
    Set TabDatasList = TabDatasDict(k(TabDataIndex - 1))
End Property
 
Public Property Get NbTabDatas() As Byte
    ' Propriété en lecture
    NbTabDatas = TabDatasDict.Count
End Property

Module de classe - Liens de parentés entre classes

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager