Enlever les accents

J'ai besoin d'enlever tous les accents d'un texte...

Tu peux utiliser l'une ou l'autre de ces fonctions. Il faut ouvrir VBA, insérer un nouveau module, ne surtout pas mettre la fonction dans le code d'une page. Tu colles la fonction. Dans ta feuille il te suffit alors de taper par ex en G2 =Virer_Accents(F2) et si ton texte en F2 contient des accents il se retrouve sans dans G2.

Function Virer_Accents$(Chaine$)
 'AV 
 Dim tmp$
 tmp = Trim(Chaine)
 For i = 1 To Len(tmp)
 x = Asc(Mid(tmp, i, 1))
 Select Case x
 Case 192 To 197: x = "A"
 Case 200 To 203: x = "E"
 Case 204 To 207: x = "I"
 Case 209: x = "N"
 Case 210 To 214: x = "O"
 Case 217 To 220: x = "U"
 Case 221: x = "Y"
 Case 224 To 229: x = "a"
 Case 232 To 235: x = "e"
 Case 236 To 239: x = "i"
 Case 241: x = "n"
 Case 240, 242 To 246: x = "o"
 Case 249 To 252: x = "u"
 Case 253, 255: x = "y"
 Case Else: x = Chr(x)
 End Select
 Virer_Accents = Virer_Accents & x
 Next
 End Function

2° possibilité :

Function Sans_accents$(Chaine$)  ' R. Dezan + Michel Pierron
 Cette fonction enlève également les Œ, œ, Æ, æ qui posent un problème sur les sytèmes anglais.
 ' remplacement des caractères accentués
 a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
 b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
 Chaine = Replace(Replace(Replace(Replace(Chaine, "œ", "oe"), "Œ", 
 "OE"), "æ", "ae"), "Æ", "AE")
 For i% = 1 To Len(Chaine)
 u% = InStr(1, a, Mid(Chaine, i, 1), 0)
 If u Then Mid(Chaine, i, 1) = Mid(b, u, 1)
 Next i
 Sans_accents = Chaine
 End Function

tu peux tester cette fonction à l'aide de la macro ci-dessous

sub Test()
 MsgBox Sans_accents("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ")
 MsgBox Sans_accents("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ")
 end sub

3° possiblité avec les API windows et de loin la plus rapide Mais attention,elle ne fonctionne qu'avec windows NT, 2000 ou XP (pas 98 ou me) et n'enlève pas les Œ, œ, Æ, æ et autres caratères très particuliers.

Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _  (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _  ByVal lpDestStr As Long, ByVal cchdest As Long) As Long  

Function SANSACCENTS(Texte As String) As String
 
 Dim I As Integer
 SANSACCENTS = Space(Len(Texte))
 For I = 0 To Len(Texte) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
 Next I
 
 End Function

Auteurs : , , ,

Mots clefs associés à cette page : , ,