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 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
| Public Function fSupprimeAccents(ByVal Chaine As String) As String
Dim Position As Integer
For Position = Len(Chaine) To 1 Step -1
Select Case Mid(Chaine, Position, 1)
Case "à", "á", "â", "ã", "ä", "å"
Chaine = Left(Chaine, Position - 1) & _
"a" & Mid(Chaine, Position + 1)
Case "Ä", "À", "Á", "Â", "Ã", "Å"
Chaine = Left(Chaine, Position - 1) & _
"A" & Mid(Chaine, Position + 1)
Case "ç"
Chaine = Left(Chaine, Position - 1) & _
"c" & Mid(Chaine, Position + 1)
Case "Ç"
Chaine = Left(Chaine, Position - 1) & _
"C" & Mid(Chaine, Position + 1)
Case "é", "è", "ë", "ê"
Chaine = Left(Chaine, Position - 1) & _
"e" & Mid(Chaine, Position + 1)
Case "É", "È", "Ë", "Ê"
Chaine = Left(Chaine, Position - 1) & _
"E" & Mid(Chaine, Position + 1)
Case "ì", "í", "î", "ï"
Chaine = Left(Chaine, Position - 1) & _
"i" & Mid(Chaine, Position + 1)
Case "Ì", "Í", "Î", "Ï"
Chaine = Left(Chaine, Position - 1) & _
"I" & Mid(Chaine, Position + 1)
Case "ñ"
Chaine = Left(Chaine, Position - 1) & _
"n" & Mid(Chaine, Position + 1)
Case "Ñ"
Chaine = Left(Chaine, Position - 1) & _
"N" & Mid(Chaine, Position + 1)
Case "ò", "ó", "ô", "õ", "ö"
Chaine = Left(Chaine, Position - 1) & _
"o" & Mid(Chaine, Position + 1)
Case "Ò", "Ó", "Ô", "Õ", "Ö"
Chaine = Left(Chaine, Position - 1) & _
"O" & Mid(Chaine, Position + 1)
Case "ù", "ú", "û", "ü"
Chaine = Left(Chaine, Position - 1) & _
"u" & Mid(Chaine, Position + 1)
Case "Ù", "Ú", "Û", "Ü"
Chaine = Left(Chaine, Position - 1) & _
"U" & Mid(Chaine, Position + 1)
Case "ý", "ÿ"
Chaine = Left(Chaine, Position - 1) & _
"y" & Mid(Chaine, Position + 1)
Case "Ý"
Chaine = Left(Chaine, Position - 1) & _
"Y" & Mid(Chaine, Position + 1)
End Select
Next Position
fSupprimeAccents = Chaine
End Function |
Partager