1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
'enlever les accents
function strtr(chaine, strFrom, strTo)
Dim c0, c1, i
for i = 1 to len(strFrom)
'récupération d'un caractère
'de la chaîne strFrom à la
'position i
c0 = mid(strFrom, i, 1)
'Si la longueur de la chaîne
'strTo dépasse celle de strFrom
'alors on remplace par rien
if i > len(strTo) Then
c1 = ""
else
c1 = mid(strTo, i, 1)
end if
'Remplacement des caractères
'dans la chaîne de départ
chaine = Replace(chaine, c0, c1)
next
'On renvoie la chaîne sans accents
strtr = chaine
end function
'@param1 => chaîne : chaîne à transformer
'@return => chaîne : retourne la chaîne traduite
function removeAccents(chaine)
Dim accent, noaccent
accent = "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûýýþÿ"
noaccent = "AAAAAAACEEEEIIIIDNOOOOOOUUUUYbsaaaaaaaceeeeiiiidnoooooouuuyyby"
removeAccents = strtr(chaine, accent, noaccent)
end function |
Partager