Vb6 - supprimer les accents d'une chaîne

Soyez le premier à donner votre avis sur cette source.

Snippet vu 33 944 fois - Téléchargée 29 fois


Contenu du snippet

Suite, à une question du Forum, voici, une petite fonction pour supprimer les accents d'une chaîne.

A vous d'ajouter les autres possibilitées d'accentuations, le mécanisme étant simple à adapter à vos besoins.

Source / Exemple :


' Définition de la conversion
Const accent As String   = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"

' La fonction :
Private Function sansAccents(ByRef s As String) As String
Dim i As Integer  
Dim lettre As String * 1
  sansAccents = s
  For i = 1 To Len(accent)
    lettre = Mid$(accent, i, 1)
    If InStr(sansAccents, lettre) > 0 Then
       sansAccents = Replace(sansAccents, lettre, Mid$(noAccent, i, 1))
    End If
  Next i
End Function 

' Exemple d'utilisation :
Private Sub Form_Load()
  Dim demo As String
  demo = "L'été, je vais sur l'île où y'a la fête jusqu'à l'aube et" & _
         " je hurle: YÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÙÚÛÜùúûü ... "
  Debug.Print demo & vbCrLf & " => " & sansAccents(demo)
End Sub

Conclusion :


++

Zlub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
27 juillet 2011

Bonjour,
Pour que les minuscules accentuées ne soient pas remplacées par des Majuscules
Sous Access, l'Option Compare Database étant défaut, il faut s'assurer
que l'Option Compare Binary soit indiquée en entète du module .

Option Explicit
Option Compare Binary

' La fonction :

Private Function sansAccents(ByRef s As String) As String
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noaccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"

Dim i As Integer
Dim lettre As String * 1
sansAccents = s
For i = 1 To Len(accent)
lettre = Mid$(accent, i, 1)
If InStr(sansAccents, lettre) > 0 Then
sansAccents = Replace(sansAccents, lettre, Mid$(noaccent, i, 1))
'Debug.Print lettre & " " & Mid$(noaccent, i, 1)
'Debug.Print sansAccents
End If
Next i

End Function

' Exemple d'utilisation :
Private Sub Form_Load()
Dim demo As String
demo = "L'été, je vais sur l'île où y'a la fête jusqu'à l'aube et" & _
" je hurle: YÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÙÚÛÜùúûü ... "
Debug.Print "Origine => " & demo
Debug.Print "Majuscule => " & UCase(demo)
Debug.Print "O Accent => " & sansAccents(demo)
Debug.Print "O Accent M => " & UCase(sansAccents(demo))

End Sub

Cordialement
LG
Messages postés
3810
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
28 mai 2020
29
Messages postés
6
Date d'inscription
jeudi 2 septembre 2004
Statut
Membre
Dernière intervention
24 juin 2013

Bonjour,

Proposition d'un petit ajout et d'une légère restructuration dans la définition de la conversion au niveau des Y :

Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüŸÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuYyNnCc"

C'est une fonction très élégante pour résoudre ce problème.

GM
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
62
pense a effectuer le changement également quand tu colles du texte dans ta box ^^
Messages postés
1
Date d'inscription
vendredi 9 septembre 2005
Statut
Membre
Dernière intervention
13 décembre 2009

Excellent programme.

je l'ai adapté pour supprimer les accents en temps réel dans une textbox.

...et ca fonctionne parfaitement.

Bravo
Afficher les 12 commentaires

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.