VBA portée function

[kevin_44]

Bonjour,

je ne parviens pas à exécuter une fonction personnalisée, je suis sûr que c'est tout bête mais je débute en VBA...

1/ Je créé une fonction qui liste des positions de caractères dans une chaîne, l'objectif étant de les supprimer s'ils sont doublés. Le but est un peu d'opérer comme une fonction SUPPRESPACE mais en choisissant les caractères que je traite (en l’occurrence, les espaces puis les sauts de ligne)

Public Function sup_car(txt As String) As String

' Tableau : liste des caractères à traiter
Dim caractere(1)
caractere(0) = chr(32) ' espace
caractere(1) = chr(10) ' saut de ligne


For x = LBound(caractere) To UBound(caractere) Step 1

    ' Position des caractères à supprimer
    ReDim car(Len(txt)) As String

    For a = 1 To Len(txt) Step 1
        If Right(Left(txt, a), 1) = caractere(x) And Right(Left(txt, a - 1), 1) = caractere(x) Then car(a) = a
    Next a

    ' Suppression des caractères aux positions déterminées
    For b = Len(txt) To 1 Step -1
        If car(b) <> "" Then
        txt = Left(txt, b - 1) & Right(txt, Len(txt) - b)
        End If
    Next b

    ' Suppression des espaces de début et fin de chaîne
    If Left(txt, 1) = caractere(x) Then txt = Right(txt, Len(txt) - 1)
    If Right(txt, 1) = caractere(x) Then txt = Left(txt, Len(txt) - 1)

Next x

End Function

2/ J'appelle cette fonction dans un autre module (dans un MsgBox pour le test)

Sub test()

    MsgBox sup_car("  xx   x x   x   x  x x x  x")

End Sub

Malgré cela, le MsgBox est vide.

Savez-vous me dire où je me trompe ?

En utilisant un point d'arrêt dans ma fonction, je constate que je rentre bien dedans pourtant (voir pièce jointe)...

Merci 🙂

 

[laurent3372]

Tu ne donnes pas de valeur de retour à ta fonction !
Avant le end sub, il faut ajouter une ligne:
sup_car = txt

 

[sylvanu]

Bonjour Kevin,
Il me semble que dans votre fonction il manque la ligne la plus importante : le retour de valeur.
A la fin d'une fonction, on doit attribuer la valeur calculée à la function.

sup_car = txt
End Function

Bonjour Laurent.

 

[laurent3372]

Bonjour Kevin et Sylvanu

 

[Staple1600]

Bonjour le fil

Essaies avec ce petit ajout

Public Function sup_car(txt As String) As String
' Tableau : liste des caractères à traiter
Dim caractere(1)
caractere(0) = Chr(32) ' espace
caractere(1) = Chr(10) ' saut de ligne
For x = LBound(caractere) To UBound(caractere) Step 1

    ' Position des caractères à supprimer
    ReDim car(Len(txt)) As String

    For a = 1 To Len(txt) Step 1
        If Right(Left(txt, a), 1) = caractere(x) And Right(Left(txt, a - 1), 1) = caractere(x) Then car(a) = a
    Next a

    ' Suppression des caractères aux positions déterminées
    For b = Len(txt) To 1 Step -1
        If car(b) <> "" Then
        txt = Left(txt, b - 1) & Right(txt, Len(txt) - b)
        End If
    Next b

    ' Suppression des espaces de début et fin de chaîne
    If Left(txt, 1) = caractere(x) Then txt = Right(txt, Len(txt) - 1)
    If Right(txt, 1) = caractere(x) Then txt = Left(txt, Len(txt) - 1)

Next x
sup_car = txt
End Function

EDITION: Désolé pour le double télescopage, je n'avais pas rafraîchi la page.
Bonjour sylvanu , bonjour laurent3372

 

[kevin_44]

Ah quelle nouille je fais 🙂 Merci beaucoup laurent3372 !

Je mets en résolu.

(juste pour ceux qui reliraient ce message, une petite coquille --> c'est avant le "end function" et non le "end sub" qu'il faut ajouter "sup_car = txt")

 

[kevin_44]

Merci à vous deux du coup, on s'est croisé 🙂

 

[Staple1600]

Re

Merci à vous deux du coup, on s'est croisé

=>kevin_44
Nous étions trois à passer dans ton fil... 🙄
Mais j'ai l’habitude d'être zappé.
Je survivrai (même si cela fait mal en dedans de moi 😉 Ouch!)

 

[kevin_44]

Oups 🙂 Merci beaucoup à toi aussi Staple1600 ;-)

Et quelle réactivité !

Bonne journée.