Mini-fonction replace pour vb5

Télécharger le projet
Commenter

Description

Remplacement d'un nombre défini d'occurences, ou de toutes celles d'une sous-chaîne, par une autre.
Destinée à remplacer la fonction "Replace" non implémentée en VB5 (sic SCALPWEB).
Les arguments sont les mêmes que pour "Replace", afin d'assurer la compatibilité le jour où l'utilisateur passe à une autre version de VB. Ceux-ci sont décrits dans l'en-tête de la fonction.
Cette fonction, actuellement nommée "ReplaceT", pour éviter les conflits, pourra être renommée "Replace" en VB5.

Source / Exemple : 


Attribute VB_Name = "ReplaceTst"
' REDLUPUS 2004 : Remplacement de la fonction "Replace" non
' implémentée en VB5
' ======================================================
Public Function ReplaceT(ByVal Expression As String, _
                         ByVal Find As String, _
                         ByVal Replace As String, _
                Optional ByVal Start As Long = 1, _
                Optional ByVal Count As Long = -1, _
                Optional ByVal Compare As Integer = vbTextCompare) _
                As String
' ------------------------------------------------------
' Destinée à remplacer la fonction "Replace" non
' implémentée en VB5.
' Les arguments sont les mêmes que pour "Replace", afin
' d'assurer la compatibilité le jour où l'utilisateur
' passe à une autre version de VB.
'   Expression      Chaîne sur laquelle le traitement doit
'                   être effectué
'   Find            Sous-chaîne à trouver
'   Replace         Sous-chaîne à substituer à "Find"
'  [Start]          défaut : 1
'                   position de début du traitement.
'                   Remarqes :
'                   1 - Quel que soit le traitement, la
'                       chaîne sera amputée des caractères
'                   2 - Si Start est supérieur à la longueur
'                       d'"Expression", une chaine vide
'                       est retournée.
'  [Count]          défaut : -1
'                   Nombre de substitutions à effectuer. "-1"
'                   permet de substituer TOUTES les occurences
'                   de "Find"
'  [Compare]        défaut : vbTextCompare
'                   Type de comparaison
'                   Pour mémoire, les autres valeurs possibles
'                   sont :
'                       vbDatabaseCompare
'                       vbBinaryCompare
'                       vbUseCompareOption
' ======================================================
Dim P As Long           ' position 1er caractère à tester
Dim L As Long           ' longueur de expression
Dim F As Long           ' longueur de la chaîne à remplacer
Dim R As Long           ' longueur chaîne de remplacement

' argument "Start" : élimination du début de chaîne
Let L = Len(Expression)
If Start > L Then
    ' parceque "Right$" n'accepte pas 1 taille négative
    Let Expression = vbNullString
ElseIf Start > 1 Then
    ' troncature d'"Expression"
    Let Expression = Right$(Expression, L - Start + 1)
    End If

ReplaceT = Expression   ' valeur retour par défaut

' argument "Find" : si chaîne vide, on retourne "Expression".
If Find = vbNullString Then Exit Function
Let F = Len(Find)

Let R = Len(Replace)    ' Taille de la chaîne de remplacement
Let P = 1               ' on commence à la première position
If Count <> 0 Then
    Do
        ' La taille d'"Expression" peut varier lors de chaque
        ' remplacement (si "Find" et "Replace" sont de longueurs
        ' différentes), c'est pourquoi l'instruction suivante
        ' est située DANS la boucle.
        Let L = Len(Expression)
        ' position de la sous-chaîne à remplacer...
        Let P = InStr(P, Expression, Find, Compare)
        ' ... si elle y figure bien
        If P > 0 Then
            Let Expression = Left$(Expression, P - 1) + _
                             Replace + _
                             Right$(Expression, (L - P - F + 1))
            ' décalage 1er caractère à comparer (position trouvée
            ' + taille de la chaîne de remplacement)
            Let P = P + R
            ' Un remplacement de moins à effectuer (si "Count">0)
            ' on continue indéfiniment si "Count" < 0
            Let Count = Count - 1
            End If
        ' Si le compteur atteint zéro (cas où on voulait un nombre
        ' défini de substitutions), où s'il n'y a plus de
        ' remplacements possibles, on sort.
        Loop Until (P <= 0) Or (Count = 0)
    End If
ReplaceT = Expression       ' retour..
End Function

Conclusion :


Comme je répondais à RENFIELD, "pourquoi je n'ai pas utilisé la fonction 'replace' de VB ?... je ne sais pas (j'utilise VBA et 'replace' existe) ! Ahhhh..lzheimer me guette !!!".
Mais si cette fonction n'est pas implémentée en VB5 (merci à SCALPWEB de me l'avoir indiqué), alors pourquoi ne pas fournir un code qui prend en charge, au moins le type de comparaison "vbTextCompare".
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (RedLupus)