Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 06 02:11:01

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

MACRO DANS EXCEL par PONTGUENNOU

RE : RECUPERER LE RESULTAS AFFICHER PAR LINVITE DE COMMANDE par jack

RECUPERER LE RESULTAS AFFICHER PAR LINVITE DE COMMANDE par liehuos001

RE : LORSQUE JE VEUX FAIRE LES ENREGISTREMENT DANS MA TABLE EN VB.NET UN MESSAGE S'AFFICHE EN ME DISANT QUE LE CHAMPS EST PETIT. QUE FAIE? par PCPT

RE : BUFFERING par pingouin84k

+ de logiciels à télécharger

1 464 966 membres
20 nouveaux aujourd'hui
15 046 membres club

Trouver une ressource

Trouvez une ressource parmi 40 094 codes, 1 303 047 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

FONCTION QUI ENLÈVE LES ACCENTS

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 : 5 154

Auteur : Sirocooo

Ecrire un message privé

Note :

4,00 / 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

ENVOI DE SMS VERS SFR

TESTEUR DE RÉSEAU TRÈS PRÉCIS

TESTEUR DE PORTS COM

Toutes les sources de Sirocooo

Sources de la même categorie

TEXTSTYLE, EDITOR HTML par jupevi

RACCOURCIR UN CHEMIN (PATH) OU URL INTERNET par Tioneb

EDITEUR DE TEXTE par ali5

SMS GENERATOR par jack

COMPARAISON DE DOSSIERS, FICHIERS ET TEXTE par RicoNuch

Toutes les sources de la catégorie Texte

Commentaires et avis

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é