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
| Option Explicit
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
Public Sub Test()
Debug.Print (EnleverAccents("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"))
Debug.Print (EnleverAccents("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ"))
Debug.Print (EnleverAccentsBis("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"))
Debug.Print (EnleverAccentsBis("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ"))
End Sub
Function EnleverAccentsBis(Chaine As String) As String
Dim intTemp As Integer
EnleverAccentsBis = Space(Len(Chaine))
For intTemp = 0 To Len(Chaine) * 2 - 2 Step 2
FoldString &H40, StrPtr(Chaine) + intTemp, 1, StrPtr(EnleverAccentsBis) + intTemp, 1
Next intTemp
End Function
Public Function EnleverAccents(ByVal Chaine) As String
Dim strAvecAccent As String, strSansAccent As String
Dim intTemp As Integer, strTemp As String
strAvecAccent = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
strSansAccent = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Chaine = Replace(Replace(Replace(Replace(Chaine, "oe", "oe"), "OE", "OE"), "æ", "ae"), "Æ", "AE")
For intTemp = 1 To Len(Chaine)
strTemp = InStr(1, strAvecAccent, Mid(Chaine, intTemp, 1), 0)
If strTemp Then Mid(Chaine, intTemp, 1) = Mid(strSansAccent, strTemp, 1)
Next intTemp
EnleverAccents = Chaine
End Function |
