Il est de bon ton de se souhaiter la bonne année. Mais vous, et vous seul, pourrez faire en sorte que cette année soit bonne, meilleure que celle qui vient de s'écouler. Apprenez à ne compter que sur vous, car personne n'est plus qualifié que vous-même pour bâtir, réparer ou améliorer votre propre vie. Personne ne fera les choses à votre place. D'ailleurs, tout ce que les autres peuvent faire, c'est souhaiter que vous le fassiez. Et ne croyez pas que tout ceux qui vous entourent vous apporteront des solutions : certains font juste partie de vos problèmes. Transformez vos résolutions en actes, et dans douze mois, retournez-vous et souriez-vous fièrement : C'était long. C'était difficile. Mais ça y est : 2017 était une bonne année, merci Moi.

iconeprogrammation.gif (3012 octets)

Extraction d'une sous-chaîne de caractère dans une sous chaîne

Cette fonction permet d'extraire une partie d'une chaîne de caractères quand celle ci a toujours la même structure. Prenons l'exemple suivant : Vous avez un fichier texte qui contient les lignes suivantes :

Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09
Yvan Desclous, Ville : Grenoble, E-Mail : desclous@machin.fr, Tél.: 11.22.33.44
Paul Truc, Ville : Berlin, E-Mail : tpaul@chose.fr, Tél.: 44.66.55.88

Pour Extraire l'E-Mail de chacune de ces personnes, je vous souhaite bonne chance, surtout s'il y en a 2'500... La petite fonction que je vous propose d'implémenter va s'occuper de tout cela...

Dans notre exemple, nous voulons mettre l'E-Mail dans une variable VARemail :

LigneComplete = "Marc Dupont, Ville : Paris, E-Mail : mdupont@truc.fr, Tél.: 43.99.88.09"
VARemail =Extraction(LigneComplete  ,   "E_Mail : "  ,    ", Tél")

VARemail contiendra exactement la chaîne suivante : mdupont@truc.fr

' UTILITE : Cette fonction permet de récupérer une chaîne de texte dans une chaîne de caractères, entre
' 2 balises.
' EXEMPLES :
' X = Extraction ("ABCDEFGHIJKL", "CD", "i") Renvoie "EFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "i") Renvoie "ABCDEFGH"
' X = Extraction ("ABCDEFGHIJKL", "#BEGIN#", "#END#") Renvoie "ABCDEFGHIJKL"
' X = Extraction ("ABCDEFGHIJKL", "J", "#END#") Renvoie "KL"
' X = Extraction ("ABCDEFGHIJKL", "J", "J") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "J", "K") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("BxxxA AyyyB", "a", "b") Renvoie "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "J") Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "XXX", "YYY") Renvoie "###INFO 3000 ERREUR : Début inexistant###"
' X = Extraction ("ABCDEFGHIJKL", "BC", "XXX") Renvoie "###INFO 3000 ERREUR : Fin inexistante ###"
' X = Extraction ("AbonjourZ AaurevoirZ", "a", "z") Renvoie "bonjour"

Function Extraction(ChaineTexte, Depuis, Jusqua)
   Dim Ctr As Integer ' Compteur polyvalent
   Dim Drapeau As Boolean ' Détermine si une erreur est survenue (les balises DEPUIS ou JUSQUA n'existent pas)
   Dim PositionDebut As Integer ' Contient la position de la fin de la chaine DEBUT + 1 caractere
   Dim PositionFin As Integer ' Contient la position du début de la chaine JUSQUA
   Dim LongueurDepuis As Integer ' Contient la longueur de la balise DEPUIS
   Dim LongueurJusqua As Integer ' Contient la longueur de la balise JUSQUA
   Dim LongueurChaineTexte As Integer ' Contient la longueur de la chaîne de caractère complète

   LongueurDepuis = Len(Depuis)
   LongueurJusqua = Len(Jusqua)
   LongueurChaineTexte = Len(ChaineTexte)

   ' Est-ce que l'utilisateur a entré un mot-clé pour commencer au début : #BEGIN#
   ' ou terminer à la fin : #END#
   If Depuis = "#BEGIN#" Then
      PositionDebut = 1
   End If
   If Jusqua = "#END#" Then
      PositionFin = LongueurChaineTexte
   End If

   If Depuis <> "#BEGIN#" Then
      ' Recherche de la délimitation DEBUT du début de la recherche
      Drapeau = False
      For Ctr = 1 To LongueurChaineTexte - LongueurDepuis
          If Mid$(ChaineTexte, Ctr, LongueurDepuis) = Depuis Then
             Drapeau = True
             PositionDebut = Ctr + LongueurDepuis
             Exit For
          End If
      Next
      ' Si la délimitation du début DEPUIS n'existe pas, générer une erreur
      If Drapeau = False Then
         Extraction = "###INFO 3000 ERREUR : Début inexistant###"
         Exit Function
      End If
   End If

   If Jusqua <> "#END#" Then
      ' Recherche de la délimitation FIN
      Drapeau = False
      For Ctr = 1 To LongueurChaineTexte - LongueurJusqua
          If Mid$(ChaineTexte, Ctr, LongueurJusqua) = Jusqua Then
             Drapeau = True
             PositionFin = Ctr - 1
             Exit For
          End If
      Next
     
      ' Si la délimitation de fin JUSQUA n'existe pas, générer une erreur
      If Drapeau = False Then
         Extraction = "###INFO 3000 ERREUR : Fin inexistante ###"
         Exit Function
      End If
   End If

   If PositionFin < PositionDebut Then
      Extraction = "###INFO 3000 ERREUR : Fin avant de début, ou retour fonction vide ###"
      Exit Function
   End If

   ' Retour correct de la fonction :
   Extraction = (Mid$(ChaineTexte, PositionDebut, PositionFin - (PositionDebut - 1)))

End Function