Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Dim myCollection As New CollectionWithDictionary
Dim key As Variant
Dim Value As Variant
' Test
Dim F As Worksheet
Set F = ThisWorkbook.Worksheets(ActiveSheet.Name)
' Ajouter des éléments à la collection
' Object
myCollection.Addobj F, "Key0"
' Variant
myCollection.Addvar "Value1", "Key1"
myCollection.Addvar "Value2", "Key2"
' Item Variant Or Object
' Item Variant
Public Property Let itemVar(MaVariable As Variant)
mItemVar = MaVariable
End Property
Public Property Get itemVar() As Variant
itemVar = mItemVar
End Property
' Item Object
Public Property Let itemObj(MaVariable As Object)
Set mItemObject = MaVariable
End Property
Public Property Get itemObj() As Object
Set itemObj = mItemObject
End Property
' Item Variant Or Object
Public Property Let itemVar(MaVariable)
If IsObject(MaVariable) Then
Set mItemVar = MaVariable
Else
mItemVar = MaVariable
End If
End Property
' Item Variant
End Property
Public Property Get itemVar() As Variant
itemVar = mItemVar
End Property
' Item Object
Public Property Get itemObj() As Object
Set itemObj = mItemObject
End Property
avec cela mais cela ne fonctionne pas
' Méthode Object Add pour ajouter une paire clé-élément
Public Sub Addobj(MaObjItem, Optional ByVal key As String)
Dim Cls As CollectionWithDictionary
Set Cls = New CollectionWithDictionary
Cls.itemObj = MaObjItem
Cls.key = key
mColl.Add item:=Cls, key:=Cls.key
End Sub
' Module de classe CollectionWithDictionary
Private mIsTerminated As Boolean
Private mKey As String ' Obligatoire. Clé associée à l'élément ajouté.
Private mItemVar As Variant ' Obligatoire. Élément Variant associé à la clé ajoutée.
Private mItemObject As Object ' Obligatoire. Élément Object associé à la clé ajoutée.
Private mColl As New Collection
' Constructeur
Private Sub Class_Initialize()
'Set mColl = New Collection
mIsTerminated = False
End Sub
' Destructeur
Private Sub Class_Terminate()
mKey = Empty: mItemVar = Empty: Set mItemObject = Nothing
Set mColl = Nothing
mIsTerminated = True
End Sub
' Item Variant Or Object
' Item Variant
Public Property Let itemVar(MaVariable As Variant)
mItemVar = MaVariable
End Property
Public Property Get itemVar() As Variant
itemVar = mItemVar
End Property
' Item Object
Public Property Let itemObj(MaVariable As Object)
Set mItemObject = MaVariable
End Property
Public Property Get itemObj() As Object
Set itemObj = mItemObject
End Property
' Key la clé pour la collection
Public Property Let key(MaVariable As String)
mKey = MaVariable
End Property
Public Property Get key() As String
key = mKey
End Property
' Lecture de la collection dans le module de classe
Public Property Get LectColl() As Collection
Set LectColl = mColl
End Property
' Lecture de la collection dans le module de classe
Public Property Get LectCollcls() As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim Cls As CollectionWithDictionary
Set Cls = col.item(mKey)
End Property
' Méthode Variant Add pour ajouter une paire clé-élément
Public Sub Addvar(ByVal MaVaritem As Variant, Optional ByVal key As String)
Dim Cls As CollectionWithDictionary
Set Cls = New CollectionWithDictionary
Cls.itemVar = MaVaritem
Cls.key = key
mColl.Add item:=Cls, key:=Cls.key
End Sub
' Méthode Object Add pour ajouter une paire clé-élément
Public Sub Addobj(ByVal MaObjItem As Object, Optional ByVal key As String)
Dim Cls As CollectionWithDictionary
Set Cls = New CollectionWithDictionary
Cls.itemObj = MaObjItem
Cls.key = key
mColl.Add item:=Cls, key:=Cls.key
End Sub
' Méthode Exists pour vérifier si une clé existe dans la collection
' Version V0
'''''''''''Function Exists(ByVal mKey As String) As Boolean
'''''''''''' Le code suivant vérifie si une clé existe
''''''''''' Dim col As Collection
''''''''''' Set col = LectColl
''''''''''' Dim Cls As CollectionWithDictionary
''''''''''' Set Cls = col.item(mKey)
''''''''''' On Error Resume Next
''''''''''' IsObject (col.item(mKey))
''''''''''' If Err.Number = 0 Then
''''''''''' ' Aucune erreur, la clé existe
''''''''''' If Not Cls.itemObj Is Nothing Then
''''''''''' Exists = True
''''''''''' ElseIf Cls.itemObj Is Nothing And Cls.itemVar <> Empty Then
''''''''''' Exists = True
''''''''''' End If
''''''''''' Else
''''''''''' ' Une erreur s'est produite, la clé n'existe pas
''''''''''' Exists = False
''''''''''' End If
''''''''''' On Error GoTo 0 ' Rétablir la gestion des erreurs normale
'''''''''''End Function
'
' Version V1
Function Exists(ByVal mKey As String) As Boolean
Dim col As Collection
Set col = LectColl
Dim Cls As CollectionWithDictionary
On Error Resume Next
Set Cls = col.item(mKey)
On Error GoTo 0
If Not Cls Is Nothing Then
If Not Cls.itemObj Is Nothing Or Cls.itemVar <> Empty Then
Exists = True
End If
End If
End Function
' Méthode Keys pour retourner un tableau contenant toutes les clés
Public Function Keys() As Variant()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim i As Integer
Dim Result() As Variant
ReDim Result(1 To col.Count)
For i = 1 To col.Count
Set Cls = col.item(i)
Result(i) = Cls.key
Next i
Keys = Result
End Function
' Méthode Items pour retourner un tableau contenant tous les éléments (sauf Object !)
Public Function Items() As Variant()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim i As Integer
Dim Result() As Variant
ReDim Result(1 To col.Count)
For i = 1 To col.Count
Set Cls = col.item(i)
Result(i) = Cls.itemVar
Next i
Items = Result
End Function
' Méthode Remove pour supprimer une paire clé-élément
Public Sub Remove(key As Variant)
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Set Cls = col.item(key)
col.Remove Cls.key
End Sub
'
' Propriété Count pour obtenir le nombre d'éléments
Public Property Get Count() As Long
Dim col As Collection
Set col = LectColl
Count = col.Count
End Property
'
' Méthode RemoveAll pour supprimer toutes les paires clé-élément
Public Sub RemoveAll()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
For i = 1 To col.Count
Set Cls = col.item(1)
col.Remove Cls.key
Next i
End Sub
Sub TestCollectionWithDictionary()
Dim myCollection As New CollectionWithDictionary
Dim key As Variant
Dim Value As Variant
' Test
Dim F As Worksheet
Set F = ThisWorkbook.Worksheets(ActiveSheet.Name)
' Ajouter des éléments à la collection
' Object
myCollection.Addobj F, "Key0"
' Variant
myCollection.Addvar "Value1", "Key1"
myCollection.Addvar "Value2", "Key2"
' Vérifier si une clé existe
If myCollection.Exists("Key2") Then
Debug.Print "La clé 'Key1' existe."
Else
Debug.Print "La clé 'Key1' n'existe pas."
End If
' Récupérer la valeur associée à une clé
key = "Key2"
If myCollection.Exists(key) Then
Dim Cls As CollectionWithDictionary
Set Cls = myCollection.LectColl.item(key)
Debug.Print "La valeur associée à la clé '" & Cls.key & "' est '" & Cls.itemVar & "'."
Else
Debug.Print "La clé '" & key & "' n'existe pas."
End If
' Afficher toutes les clés de la collection
Dim Keys() As Variant
Keys = myCollection.Keys
Dim i As Long
For i = LBound(Keys) To UBound(Keys)
Debug.Print "Clé : " & Keys(i)
Next i
i = Empty
' Afficher toutes les Items de la collection
Dim Items() As Variant
Items = myCollection.Items
'Dim i As Long
For i = LBound(Items) To UBound(Items)
If Items(i) = Empty Then Debug.Print "Clé : " & "Object" Else Debug.Print "Clé : " & Items(i)
Next i
' Supprimer un élément de la collection
myCollection.Remove "Key0"
' Afficher le nombre d'éléments restants
Debug.Print "Nombre d'éléments dans la collection : " & myCollection.Count
' Supprimer tous les éléments de la collection
myCollection.RemoveAll
Debug.Print "Nombre d'éléments après suppression : " & myCollection.Count
End Sub
' Récupérer la valeur associée à une clé
key = "Key2"
If myCollection.Exists(key) Then
Dim Cls As CollectionWithDictionary
Set Cls = myCollection.LectColl.item(key)
Debug.Print "La valeur associée à la clé '" & Cls.key & "' est '" & Cls.itemVar & "'."
Else
Debug.Print "La clé '" & key & "' n'existe pas."
End If
Sub Test()
Dim f As Worksheet
Set f = ThisWorkbook.Worksheets(ActiveSheet.Name)
Dim r As Range
Set r = f.Range("A1:E20")
Dim Text As String
Text = "Le texte que j'ai écris ici"
Dim Stock As New ClasseLetGetSet ' Stock le type d'objet
Stock.Property_Name = Text
MsgBox Stock.Property_Name
Set Stock.Property_Name = r
MsgBox Stock.Property_Name.Address
End Sub
'Property - Variant
Private field_vValue As Variant
Property Get Property_Name() As Variant
If IsObject(field_vValue) Then
Set Property_Name = field_vValue
Else
Property_Name = field_vValue
End If
End Property
' You could use either Let or Set
Property Let Property_Name(vData As Variant)
field_vValue = vData
End Property
Property Set Property_Name(vData As Variant)
Set field_vValue = vData
End Property
Public elements As New Collection
Public key
Public item
Public keys
Public items
Public Function Add(k, i)
Dim cl As New dictionnaire
cl.key = k
cl.item = i
Me.elements.Add cl
End Function
Dim dico As dictionnaire
Sub ecriture()
Set dico = New dictionnaire
dico.Add "toto", "28"
dico.Add "titi", "54"
dico.Add "riri", "48"
End Sub
Sub lecture()
MsgBox dico.elements.Count
For Each elem In dico.elements
MsgBox "key: " & elem.key & "--item: " & elem.item
Next
End Sub
' Module standard (Module1)
Sub TestCollectionWithDictionary()
Dim myCollection As New CollectionWithDictionary
Dim key As Variant
Dim Value As Variant
' Test
Dim F As Worksheet
Set F = ThisWorkbook.Worksheets(ActiveSheet.Name)
' Ajouter des éléments à la collection
' Object
myCollection.Add F, "Key0"
' Variant
myCollection.Add "Value1", "Key1"
myCollection.Add "Value2", "Key2"
' Vérifier si une clé existe
If myCollection.Exists("Key1") Then
Debug.Print "La clé 'Key1' existe."
Else
Debug.Print "La clé 'Key1' n'existe pas."
End If
' Récupérer la valeur associée à une clé
key = "Key2"
If myCollection.Exists(key) Then
Dim col As Collection
Set col = myCollection.LectColl
Dim Cls As CollectionWithDictionary
Set Cls = col.item(key)
Debug.Print "La valeur associée à la clé '" & Cls.key & "' est '" & Cls.item & "'."
Else
Debug.Print "La clé '" & key & "' n'existe pas."
End If
' Afficher toutes les clés de la collection
Dim Keys() As Variant
Keys = myCollection.Keys
Dim i As Long
For i = LBound(Keys) To UBound(Keys)
Debug.Print "Clé : " & Keys(i)
Next i
i = Empty
' Afficher toutes les Items de la collection
Dim Items() As Variant
Items = myCollection.Items
'Dim i As Long
For i = LBound(Items) To UBound(Items)
If Items(i) = Empty Then Debug.Print "Clé : " & "Object" Else Debug.Print "Clé : " & Items(i)
Next i
' Supprimer un élément de la collection
myCollection.Remove "Key0"
' Afficher le nombre d'éléments restants
Debug.Print "Nombre d'éléments dans la collection : " & myCollection.Count
' Supprimer tous les éléments de la collection
myCollection.RemoveAll
Debug.Print "Nombre d'éléments après suppression : " & myCollection.Count
End Sub
' Module de classe CollectionWithDictionary
Private mIsTerminated As Boolean
Private mKey As String ' Obligatoire. Clé associée à l'élément ajouté.
Private mItem As Variant ' Obligatoire. Élément Variant associé à la clé ajoutée. (Variant / Object)
Private mColl As New Collection
' Constructeur
Private Sub Class_Initialize()
'Set mColl = New Collection
mIsTerminated = False
End Sub
' Destructeur
Private Sub Class_Terminate()
mKey = Empty: mItemVar = Empty: Set mItemObject = Nothing
Set mColl = Nothing
mIsTerminated = True
End Sub
' Item Variant Or Object
Public Property Let item(MaVariable As Variant)
mItem = MaVariable
End Property
Public Property Set item(MaVariable As Variant)
Set mItem = MaVariable
End Property
Public Property Get item() As Variant
On Error Resume Next
If IsObject(field_vValue) Then
Set item = mItem
Else
item = mItem
End If
On Error GoTo 0
End Property
' Key la clé pour la collection
Public Property Let key(MaVariable As String)
mKey = MaVariable
End Property
Public Property Get key() As String
key = mKey
End Property
' Lecture de la collection dans le module de classe
Public Property Get LectColl() As Collection
Set LectColl = mColl
End Property
' Lecture de la collection dans le module de classe
Public Property Get LectCollcls() As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim Cls As CollectionWithDictionary
Set Cls = col.item(mKey)
End Property
' Méthode Variant/Object Add pour ajouter une paire clé-élément
Public Sub Add(ByVal item As Variant, Optional ByVal key As String)
Dim Cls As CollectionWithDictionary
Set Cls = New CollectionWithDictionary
If IsObject(item) Then
Set Cls.item = item
Cls.key = key
mColl.Add item:=Cls, key:=Cls.key
Else
Cls.item = item
Cls.key = key
mColl.Add item:=Cls, key:=Cls.key
End If
End Sub
' Méthode Exists pour vérifier si une clé existe dans la collection'
' Version V2
Function Exists(ByVal mKey As String) As Boolean
Dim col As Collection
Set col = LectColl
Dim Cls As CollectionWithDictionary
On Error Resume Next
Set Cls = col.item(mKey)
On Error GoTo 0
Debug.Print Err.Number
If Not Cls Is Nothing Then
Exists = True
End If
End Function
' Méthode Keys pour retourner un tableau contenant toutes les clés
Public Function Keys() As Variant()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim i As Integer
Dim Result() As Variant
ReDim Result(1 To col.Count)
For i = 1 To col.Count
Set Cls = col.item(i)
Result(i) = Cls.key
Next i
Keys = Result
End Function
' Méthode Items pour retourner un tableau contenant tous les éléments (sauf Object !)
Public Function Items() As Variant()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Dim i As Integer
Dim Result() As Variant
ReDim Result(1 To col.Count)
For i = 1 To col.Count
Set Cls = col.item(i)
If Cls.item <> Empty Then
Result(i) = Cls.item
End If
Next i
Items = Result
End Function
' Méthode Remove pour supprimer une paire clé-élément
Public Sub Remove(key As Variant)
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
Set Cls = col.item(key)
col.Remove Cls.key
End Sub
'
' Propriété Count pour obtenir le nombre d'éléments
Public Property Get Count() As Long
Dim col As Collection
Set col = LectColl
Count = col.Count
End Property
'
' Méthode RemoveAll pour supprimer toutes les paires clé-élément
Public Sub RemoveAll()
Dim Cls As CollectionWithDictionary
Dim col As Collection
Set col = LectColl
For i = 1 To col.Count
Set Cls = col.item(1)
col.Remove Cls.key
Next i
End Sub
Dim Cls As CollectionWithDictionary
Set Cls = col.item(key)
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?
We use cookies and similar technologies for the following purposes:
Est ce que vous acceptez les cookies et ces technologies?