Function f_ArrayAddElement
Publié: 26 Oct 2009 à 14:00Il y avait longtemps que je n'avais publié de code....
- Code : Tout sélectionner
Function f_ArrayAddElement(vArray As Variant, vElem As Variant) As Integer
Dim iLBound As Integer
Dim iUBound As Integer
Dim iNdx As Integer
On Error Goto HANLDE_ERROR
' Valeur de retour par défaut
f_ArrayAddElement=False
If Isempty(vElem) Then
Exit Function
' Tableau ?
Elseif Isarray(vElem) Then
Exit Function
' Zéro binaire ?
Elseif Isnull(vElem) Then
Exit Function
' On prévoit autre chose ?
Else
' ---- Dummy
End If
If Isempty(vArray) Then
Redim vArray(0)
iNdx = 0
Else
iLBound=Lbound(vArray)
iUBound=Ubound(vArray)
If Not (Isnull(vArray) Or Cstr(vArray(iUBound))="") Then
iNdx = iLBound + (iUBound - iLBound + 1)
Redim Preserve vArray(iNdx)
Else
iNdx=iUBound
End If
End If
If Isscalar(vElem) Then
vArray(iNdx) = vElem
Elseif Isobject(vElem) Then
Set vArray(iNdx)=vElem
Else
' Type d'élément inattendu - On rejete
Exit Function
End If
f_ArrayAddElement=True
FIN:
Exit Function
HANLDE_ERROR:
Msgbox "Erreur n° " & Err & " : " & Error$ & " - Ligne " & Erl,16,"Erreur fonction " & Lsi_info(2)
f_ArrayAddElement=False
Resume FIN
End Function