FONCTION QUI ENLÈVE LES ACCENTS , Source N°4063

Information sur la source

Catégorie :Texte Niveau : Débutant Date de création : 17/07/2002 Date de mise à jour : 17/07/2002 22:57:42 Vu : 4 366

Auteur : Sirocooo

Ecrire un message privé

Note :

4,00 / 10

1
2
3
4
5
6
7
8
9
10

Commentaire sur cette source (7)

Ajouter un commentaire et/ou une note

Description

une toute petite fonction qui enlève les accents à un string
simple mais efficace.
ca peut servire

Source

Function SansAccent(ByVal sText As String) As String
'--- Remplace les caractères accentués par des non accentués
Dim i As Integer
Dim Lettre As String
For i = 1 To Len(sText)
Lettre = Mid$(sText, i, 1)
If Asc(Lettre) > 127 Then
Select Case Lettre
'Majuscule
Case "É": Lettre = "E"
Case "È": Lettre = "E"
Case "Ê": Lettre = "E"
Case "Ë": Lettre = "E"
Case "Ä": Lettre = "A"
Case "Ï": Lettre = "I"
Case "Î": Lettre = "I"
Case "Ç": Lettre = "C"
Case "Ü": Lettre = "U"
Case "Û": Lettre = "U"
Case "Ö": Lettre = "O"
'Minuscule
Case "é": Lettre = "e"
Case "è": Lettre = "e"
Case "ä": Lettre = "a"
Case "à": Lettre = "a"
Case "ê": Lettre = "e"
Case "ë": Lettre = "e"
Case "ï": Lettre = "i"
Case "î": Lettre = "i"
Case "ç": Lettre = "c"
Case "ü": Lettre = "u"
Case "û": Lettre = "u"
Case "ö": Lettre = "o"
End Select
End If
SansAccent = SansAccent + Lettre
Next i
End Function

Function SansAccent(ByVal sText As String) As String
   '--- Remplace les caractères accentués par des non accentués
   
   Dim i As Integer
   Dim Lettre As String
   
   For i = 1 To Len(sText)
      Lettre = Mid$(sText, i, 1)
      If Asc(Lettre) > 127 Then
         Select Case Lettre
            'Majuscule
            Case "É": Lettre = "E"
            Case "È": Lettre = "E"
            Case "Ê": Lettre = "E"
            Case "Ë": Lettre = "E"
            Case "Ä": Lettre = "A"
            Case "Ï": Lettre = "I"
            Case "Î": Lettre = "I"
            Case "Ç": Lettre = "C"
            Case "Ü": Lettre = "U"
            Case "Û": Lettre = "U"
            Case "Ö": Lettre = "O"
            'Minuscule
            Case "é": Lettre = "e"
            Case "è": Lettre = "e"
            Case "ä": Lettre = "a"
            Case "à": Lettre = "a"
            Case "ê": Lettre = "e"
            Case "ë": Lettre = "e"
            Case "ï": Lettre = "i"
            Case "î": Lettre = "i"
            Case "ç": Lettre = "c"
            Case "ü": Lettre = "u"
            Case "û": Lettre = "u"
            Case "ö": Lettre = "o"
         End Select
      End If
      SansAccent = SansAccent + Lettre
   Next i

End Function

Sources du même auteur

Toutes les sources de Sirocooo

Sources de la même categorie

Toutes les sources de la catégorie Texte

Commentaires

Commentaire de leneuf22 le 18/07/2002 20:19:10

Héhé, que fais tu des À, Á, Â, Ã, Å...
Je plaisante, ton code est pas mal du tout ;-) (quoique le À ça peut servir)
Commentaire de Sirocooo le 18/07/2002 21:59:50

Tiend comment ca le À m'a échappé !!
Merci, je rectifie.
Commentaire de ephores le 08/08/2004 11:26:00

Merci ta fonction m'a été utile, tu as toutefois oublié quelques caractères , come â ou ô entre autre.
Mais on peut bien le faire quand même !
Commentaire de ephores le 08/08/2004 11:27:55

peux tu m'expliquer ça :

If Asc(Lettre) > 127 Then

Merci !
Commentaire de rjl61 le 25/07/2005 14:29:15

Merci de cette fonction toujours utile, en 2005, aux nuls comme moi ; j'ai adapté à mon utilisation : c'est super. RJL20050725
Commentaire de cecemel1 le 18/08/2005 23:47:50

J'ai un peu transformé le code...
Pour moi, peu importe les majuscules ou minuscules parce que je transforme tout en majuscule après (avec Ucase() )...

Voici le bout de code :

Public Function SansAccents(Texte As String)
    SansAccents = Replace(Texte, "é", "e")
    SansAccents = Replace(SansAccents, "è", "e")
    SansAccents = Replace(SansAccents, "ä", "e")
    SansAccents = Replace(SansAccents, "à", "a")
    SansAccents = Replace(SansAccents, "ê", "e")
    SansAccents = Replace(SansAccents, "ë", "e")
    SansAccents = Replace(SansAccents, "î", "i")
    SansAccents = Replace(SansAccents, "ï", "i")
    SansAccents = Replace(SansAccents, "ç", "c")
    SansAccents = Replace(SansAccents, "û", "u")
    SansAccents = Replace(SansAccents, "ü", "u")
    SansAccents = Replace(SansAccents, "ô", "o")
    SansAccents = Replace(SansAccents, "â", "a")
    SansAccents = Replace(SansAccents, "ö", "o")
    SansAccents = Replace(SansAccents, "ù", "u")
    SansAccents = Replace(SansAccents, "ò", "o")

End Function

Je l'applique sur un txbox_change, et je n'ai aucun soucis !
Voilà, si non, très bien aussi
Hervé
Commentaire de FLYeRNeT le 06/04/2007 15:30:40

il manque Case "Â": Lettre = "A"
Case "Ô": Lettre = "O" etc....