Attribute VB_Name = "Exploser_v110"
'----------------------------------------------------------------------------------------
' Procédure_____: Exploser
' Date__________: 07/01/2022
' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=267
' Objet_________: Convertir une Chaine avec séparateur en Tableau
' Référence_____: Fonction de conversion
' Appel_________: x_LeTableau = Exploser(x_LeSep, x_LaChaine, opt. x_NonVide)
' Retour________: Tableau contenant tous les éléments séparés
' Options_______: Si x_NonVide := true, ignore les chaines vides
' Compatibilité_: (2003-2019)Office     (11.0-16.0)Excel     (+)32-bit     (+)64-bit
' Statut________: (x)Validé ()En attente validation ()En cours développement
'----------------------------------------------------------------------------------------
' 2013.02.16 v1.00 DEV Création initiale, conversion d'une Chaine de Caractères en Tableau
' 2021.03.19 v1.01 BUG ByRef par défaut en VBA6 peut planter dans le transfert de variables
'                  FIX Force l'utilisation de ByVal pour tous les champs (VBA6+)
'                  DEV Amélioration de la robustesse aux erreurs de paramètres transmis
' 2022.01.07 v1.10 DEV Possibilité d'ignorer les fragments de chaine vides
'
Option Explicit

Function Exploser(ByVal x_LeSep As String, ByVal x_LaChaine As String, Optional ByVal x_NonVide As Boolean) As Variant
  Dim i, j As Variant
  Dim Resultat() As Variant
  ReDim Resultat(0)
  i = 1
  j = InStr(i, x_LaChaine & x_LeSep, x_LeSep)
  If (x_LeSep <> "" And x_LaChaine <> "" And j > 0) Then
    Do While j > 0
      Resultat(UBound(Resultat)) = Mid(x_LaChaine, i, j - i)
      i = j + Len(x_LeSep)
      j = InStr(i, x_LaChaine & x_LeSep, x_LeSep)
      If Not x_NonVide Then
        ' Accepte les vides (par défaut)
        ReDim Preserve Resultat(UBound(Resultat) + 1)
      Else
        If Resultat(UBound(Resultat)) <> "" Then
          ' Accepte que les non-vides
          ReDim Preserve Resultat(UBound(Resultat) + 1)
        End If
      End If
    Loop
    ' Supprime la dernière place inutilisée
    ReDim Preserve Resultat(UBound(Resultat) - 1)
  Else
    ' Pas de découpe possible
    Resultat(0) = x_LaChaine
  End If
  Exploser = Resultat
End Function