CollectionP

'CLASS

Option Explicit
Dim theCollection As New Collection
Private m_Delim As String
Const DefaultDelim As String = ","
Public Event Erreur(ByVal FunctionName As String, _
ByVal Number As Long, ByVal Description As String, _
ByVal DataError As String)
Private Sub Class_Initialize()
m_Delim = DefaultDelim
End Sub

Private Sub Class_Terminate()
Set theCollection = Nothing
End Sub

Public Sub Add(Item As Variant, Optional ByVal Key As Variant, _
Optional ByVal Before As Variant, _
Optional ByVal After As Variant)
On Error Goto err_Occur
theCollection.Add Item, Key, Before, After
On Error Goto 0
err_Continu:
Exit Sub
err_Occur:
RaiseEvent Erreur("Add", Err.Number, Err.Description, "")
Resume err_Continu
End Sub

Public Sub RemoveKey(ByVal Key As String)
On Error Goto err_Occur
theCollection.Remove Key
On Error Goto 0
err_Continu:
Exit Sub
err_Occur:
RaiseEvent Erreur("RemoveKey", Err.Number, Err.Description, Key)
Resume err_Continu
End Sub

Public Sub Remove(ByVal IndexOrKey As Variant)
On Error Goto err_Occur
theCollection.Remove IndexOrKey
On Error Goto 0
err_Continu:
Exit Sub
err_Occur:
RaiseEvent Erreur("Remove", Err.Number, Err.Description, IndexOrKey)
Resume err_Continu
End Sub

Public Sub RemoveIndex(ByVal Index As Long)
On Error Goto err_Occur
If Index <= theCollection.Count Then
theCollection.Remove Index
Else
RaiseEvent Erreur("RemoveIndex", 9, _
"Subscript out of range, Max=" + _
CStr(theCollection.Count), Index)
End If
On Error Goto 0
err_Continu:
Exit Sub
err_Occur:
MsgBox Err.Number
RaiseEvent Erreur("RemoveIndex", Err.Number, _
Err.Description, Index)
Resume err_Continu
End Sub

Public Sub RemoveAll()
If theCollection.Count = 0 Then Exit Sub
Dim element As Variant
For Each element In theCollection
theCollection.Remove 1
Next element
End Sub

Public Property Get Count() As Long
On Error Goto err_Occur
Count = theCollection.Count
On Error Goto 0
err_Continu:
Exit Function
err_Occur:
RaiseEvent Erreur("Count", Err.Number, Err.Description, "")
Resume err_Continu
End Property

Public Function Item(ByVal IndexOrKey As Variant) As Variant
On Error Goto err_Occur
Item = theCollection.Item(IndexOrKey)
On Error Goto 0
err_Continu:
Exit Function
err_Occur:
RaiseEvent Erreur("Item", Err.Number, Err.Description, IndexOrKey)
Resume err_Continu
End Function

Public Function IfItemIsThere(ByVal Index As Long) As Boolean
Dim temp As Variant
On Error Goto err_Occur
temp = theCollection.Item(Index)
On Error Goto 0
IfItemIsThere = True
err_Continu:
Exit Function
err_Occur:
IfItemIsThere = False
Resume err_Continu
End Function

Public Function IfKeyIsThere(ByVal Key As String) As Boolean
Dim temp As Variant
On Error Goto err_Occur
temp = theCollection.Item(Key)
On Error Goto 0
IfKeyIsThere = True
err_Continu:
Exit Function
err_Occur:
IfKeyIsThere = False
Resume err_Continu
End Function

Public Property Get DelimStringDataError() As String
DelimStringDataError = m_Delim
End Property

Public Property Let DelimStringDataError(ByVal NewDelim As String)
m_Delim = NewDelim
End Property

'***************************************************************

' FORM

'***************************************************************

'Copy/Paste this lines in a Form called frmMain

'Copier/Coller ces lignes dans une Form nommer frmMain

Option Explicit
'The Declaration for Handle the Error Event of Collection Plus

Dim WithEvents myCol As CollectionPlus
Private Sub Form_Load()
'Initialize Collection

Set myCol = New CollectionPlus
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set myCol = Nothing
Set frmMain = Nothing
End
End Sub

Private Sub cmdTestCol_Click()
'The Add,Item,Remove and Count are same as Collection

myCol.Add "My Item", "My Key" ',"Before Key","After Key" [Optional]
myCol.Add "Second"

'Verify my Items

MsgBox "Have Item 1 : " + CStr(myCol.IfItemIsThere(1)) + _
vbCrLf + vbCrLf + "Have Key 'My Key' : " + _
CStr(myCol.IfKeyIsThere("My Key")) + vbCrLf + _
vbCrLf + "Have Item 3 : " + _
CStr(myCol.IfItemIsThere(3)), _
vbInformation + vbSystemModal, "CollectionPlus"

'An Error Event Occur (without Crash !)

myCol.Remove 5

'This gonna Delete "Second" (Like Collection)

myCol.RemoveKey ""

'Get Count

MsgBox "Collection Count: " + CStr(myCol.Count), _
vbInformation + vbSystemModal, "CollectionPlus"

'Now Remove All Items

myCol.RemoveAll

End Sub

'Error Event of CollectionPlus

Private Sub myCol_Erreur(ByVal FunctionName As String, _
ByVal Number As Long, ByVal Description As String, _
ByVal DataError As String)
MsgBox "FunctionName: " + FunctionName + vbCrLf + "Number: " _
+ CStr(Number) + vbCrLf + _
"Description: " + Description + vbCrLf + "DataError: " + DataError, _
vbInformation + vbSystemModal, "Error Event CollectionPlus !"
End Sub

SEE MY NEW VERSION
Create a New Class and name it CollectionPlus (optional)
Copy/Paste the following Code
Creer une nouvelle Class et nommez-la CollectionPlus
Copier/Coller toutes les prochaines lignes