XL 2013 comment lire les éléments d'une collection dans une boucle

Option Explicit
 
' API pour déplacement de zone mémoire
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
' --------------------------------------------------------------------
' Renvoit la clé d'un item d'indice pItem d'une collection pColl
' --------------------------------------------------------------------
Function CollGetKey(pColl As Collection, pItem As Long) As String
Dim lBuffer(1 To 8) As Long ' Buffer pour information sur la collection
Dim lItem(1 To 7) As Long ' Buffer pour information sur l'Item
Dim lKey() As Byte ' Buffer pour la clé de l'item
Dim lCpt As Long ' Compteur d'item
Dim lPtr As Long ' Pointeur
Dim lSize As Long ' Taille de la clé
On Error GoTo Gestion_Erreurs
' Test objet initialisé
If ObjPtr(pColl) <> 0 Then
    ' Lecture informations de la collection
    RtlMoveMemory lBuffer(1), ByVal ObjPtr(pColl), 8 * 4
    ' Lecture informations du premier item
    If lBuffer(7) <> 0 Then
        RtlMoveMemory lItem(1), ByVal lBuffer(7), 7 * 4
        ' Boucle pour lire les items
        Do
            lCpt = lCpt + 1
            ' Si l'indice de l'item correspond
            If lCpt = pItem Then
                ' Pointeur vers clé
                lPtr = lItem(5)
                ' Si une clé existe
                If lPtr <> 0 Then
                    ' Taille de la clé
                    RtlMoveMemory lSize, ByVal lPtr - 4, 4
                    ' Buffer de réception de la clé
                    ReDim lKey(1 To lSize)
                    ' Récupère la clé
                    RtlMoveMemory lKey(1), ByVal lPtr, lSize
                    ' Conversion unicode
                    CollGetKey = StrConv(lKey(), vbUnicode)
                    CollGetKey = StrConv(CollGetKey, vbFromUnicode)
                    Exit Do
                Else
                    ' Pas de clé
                    CollGetKey = ""
                    Exit Do
                End If
            Else ' Sinon, on passe à l'item suivant
                ' Pointeur vers item suivant
                lPtr = lItem(7)
                If lPtr <> 0 Then
                    ' Lecture informations de l'item
                    RtlMoveMemory lItem(1), ByVal lPtr, 7 * 4
                Else
                    ' On a parcouru tous les items => pas normal
                    CollGetKey = ""
                    Exit Do
                End If
            End If
        Loop
    Else
        CollGetKey = ""
    End If
Else
    CollGetKey = ""
End If
' Gestion des erreurs
On Error GoTo 0
Exit Function
Gestion_Erreurs:
    CollGetKey = ""
End Function

Sub TestCollKey()
Dim Collect As New Collection, i As Long
Collect.Add "toto", "54"
Collect.Add "titi", "28"
Collect.Add "fifi", "32"

For i = 1 To Collect.Count
Debug.Print Collect(i) & " ," & CollGetKey(Collect, i)
Next
End Sub