Public Function MultiSuperSplit(ByVal strSource As String, _
bolStockeTroncs As Boolean, _
bolStockeSepars As Boolean, _
varSepars As Variant) As String()
On Error GoTo MultiSuperSplitErr
' Source de taille quelconque, Séparateurs de tailles quelconques
' Séparateur unique ou tableau de séparateurs (en nombre quelconque)
' strSource -> chaîne à traiter
' bolStockeTroncs -> garder ou non les troncs
' bolStockeSepars -> garder ou non les séparateurs
' varSepars -> séparateur ou tableau de séparateurs
Dim strLue As String 'la chaine lue
Dim strRes() As String 'temporaire
Dim varSep As Variant 'pour l'énumération des séparateurs
Dim i As Long
i = 1
'arrêt qd chaine cible est vide
'ou indice parcours au delà chaine
While Len(strSource) > 0 And Len(strSource) >= i
'pour chaque séparateur
For Each varSep In varSepars
'lit un tronc de la taille du séparateur
strLue = Mid$(strSource, i, Len(varSep))
'si le tronc vaut le séparateur et n'est pas vide
If (strLue = CStr(varSep)) And (strLue <> vbNullString) Then
's'il faut stocker le tronc
If bolStockeTroncs Then
'ajoute un élément au tableau
ReDim Preserve strRes(UBound(strRes) + 1)
'stocke le tronc dans le tableau
strRes(UBound(strRes)) = Left$(strSource, i - 1)
End If
's'il faut stocker le séparateur
If bolStockeSepars Then
'ajoute un élément au tableau
ReDim Preserve strRes(UBound(strRes) + 1)
'stocke le séparateur
strRes(UBound(strRes)) = strLue
End If
'consomme le tronc de la chaine et le séparateur
strSource = Right$(strSource, Len(strSource) - (i + Len(varSep) - 1))
'indice parcours au départ
i = 0
'quitte l'énumération
Exit For
End If
Next varSep
'incrémente l'indice de parcours
i = i + 1
Wend
'si la chaine n'est pas consommée entièrement
If Len(strSource) > 0 Then
's'il faut stocker le tronc
If bolStockeTroncs Then
'ajoute un élément
ReDim Preserve strRes(UBound(strRes) + 1)
'stocke le dernier tronc
strRes(UBound(strRes)) = strSource
End If
End If
'publie le tableau
MultiSuperSplit = strRes
Exit Function
MultiSuperSplitErr:
'si le tableau n'est pas initialisé
If Err.Number = 9 Then
ReDim strRes(0) 'initialise à 1 élément
Resume Next 'reprend l'exécution à la suite
'si on reçoit un séparateur au lieu d'un tableau
ElseIf Err.Number = 13 Then
varSepars = Array(varSepars) 'transtype en tableau
Resume 'reprend à l'erreur
Else
'c'est mort
MsgBox Err.Number & _
vbCrLf & Err.Description & _
vbCrLf & "MultiSuperSplit()" & _
vbCrLf & "Prévenez RVBLog, S.V.P.!"
End If
End Function
'Exemple d'utilisation (pas grand chose n'a changé)
'faites un copier/coller pour tester (parce qu'à lire...)
Private Sub Command1_Click()
MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, "%e"), "_")
MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, Array("%e", "%i", "%j")), "_")
MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, False, Array("%e", "%i", "%j")), "_")
MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", False, True, Array("%e", "%i", "%j")), "_")
MsgBox Join(MultiSuperSplit("", True, True, Array("%e", "%i", "%j")), "_")
MsgBox Join(MultiSuperSplit("abc", True, True, Array("")), "_")
MsgBox Join(MultiSuperSplit("abc", True, True, vbNullString), "_")
MsgBox Join(MultiSuperSplit(vbNullString, True, True, "abc"), "_")
MsgBox Join(MultiSuperSplit(vbNullString, True, True, Null), "_")
MsgBox Join(MultiSuperSplit("", True, True, Array("")), "_")
MsgBox Join(MultiSuperSplit("", True, True, ""), "_")
MsgBox Join(MultiSuperSplit("123", True, True, 2), "_")
MsgBox Join(MultiSuperSplit("123", True, True, "abcdefghijklmnopqrstuvw"), "_")
MsgBox Join(MultiSuperSplit("abc%edef%ighi%jjkl", True, True, Array("%e", "%i", "%j")), "_")
End Sub