Suppression des accents

Bonjour Flo;
C'est la faute à Laurent qui complique à plaisir pour te perturber; au plus
simple:

Function SANSACCENTS_2(Texte As String) As String
Dim strTemp As String, C As String * 1, I As Long
strTemp = Space(Len(Texte))
FoldString &H40, Texte, -1, strTemp, Len(Texte)
For I = 1 To Len(Texte)
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS_2 = SANSACCENTS_2 & C
Next I
End Function

MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:edQdpZCFFHA.1260@TK2MSFTNGP12.phx.gbl...

En comparant la vitesse d'exécution, vos deux macros sont équivalentes
(2 sec pour traiter l'ensemble des réponses aux questions d'excelabo !)
Voilà qui m'a fait mettre immédiatement au placard ma petite fonction
avec des arrays !
Cela dit j'ai gardé celle de RD-MP, biscotte je la comprends...
Heu... t'explique là Laurent ? c'est quoi le foldstring ?

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 13:01, :

Pour compléter la collection, dans un registre tout autre que tu connais
bien... ;-)

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

Function SANSACCENTS(Texte As String) As String

Dim strTemp As String, C As String * 1
Dim cchdest As Long, I As Long
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
strTemp = Space(cchdest)
FoldString &H40, Texte, -1, strTemp, cchdest
For I = 1 To cchdest
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS = SANSACCENTS & C
Next I

End Function

Laurent

Bounjour Robert;
Ton intéressante fonction est simplifiable:

Function Sans_accents$(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
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

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

MP

"Herdet" <rdezan@noos.fr> a écrit dans le message de
news:O$hyM43EFHA.2700@TK2MSFTNGP14.phx.gbl...

Oups, une petite erreur qui oubliait les caractères non accentués et
les

chiffres

Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
car = Mid(Src, i, 1)
If InStr(1, a, car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = car Then Dest = Dest &
Mid(b, j,
1): Exit For
Next
Else
Dest = Dest & car
End If
Next
Sans_accents = Dest
'---- Testé sur 0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ
End Function

"Herdet" <rdezan@noos.fr> a écrit dans le message de news:
uQldvy3EFHA.3984@TK2MSFTNGP14.phx.gbl...

Bonjour Michel,
Une solution VBA un peu plus générale sans Select Case ni codes ASCII
A adapter
Cordialement
Robert Dezan
-------------------------------------------------------
Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
Car = Mid(Src, i, 1)
If InStr(1, a, Car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = Car Then Dest = Dest & Mid(b,

j,

1): Exit For
Next
End If
Next
Sans_accents = Dest
End Function

-----------------------------------------------------------------------
-

"Michel NOLF" <michel.nolf.sansspam@tiscali.fr> a écrit dans le
message

de

news: %237ZKbx2EFHA.3244@TK2MSFTNGP15.phx.gbl...

Bonjour à tous
Je voudrais pouvoir supprimer les accents d'une chaine de
caractères.

Il

y
a-t-il un moyen sans être obligé de passer par un select case
é,ù,î,ï

etc.
Les caractères peuvent être en LCase ou UCase.
Merci pour votre aide
Michel

Salut Starwing

Si tu savais le nombre d'astuces qui sont en attente... Ce qui manque
c'est le temps de les traiter. Et puis il faut aussi reprendre,
compléter, simplifier, illustrer celles qui sont déjà en ligne.

Toutes les proc d'excelabo en pdf ! rien que ça ? T'es sympa là mais ...
j'ai quelques autres occupations (de plus en plus prenantes). Ce n'est
en fait même pas une question de temps, c'est une question de
philosophie : l'intérêt d'un site web c'est de bouger. Et puis d'être
consultable avec des outils de recherche.
Si c'est une bible dont tu as besoin, il y en a d'excellentes en
librairie. Je ne vis pas d'excel mais d'autres oui... et puis moi les
bibles ... (personal joke avec AV et ses paters aussi peu noster que les
miens !)
Combien de bouquins (si possible très très gros) as tu déjà acheté en
ayant l'impression qu'à force de les voir sur ta table de nuit, leur
contenu allait finir par rentrer tout seul dans ton crane ? Alors un de
plus ou de moins...

Je passe tu t'en doutes beaucoup de mon temps libre pour mettre à jour
le site. Tu peux bien passer quelques minutes à y récupérer ce qui
t'intéresse ? Chercher l'astuce qui répond à ton problème c'est déjà en
partie le résoudre ! Savoir quelle est la bonne question c'est souvent
faire un immense pas vers sa résolution.
:-)

(et merci de ta signature !)

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 14:49, :

Bonjour Misange,

Il va falloir renouveler les pages d'Excelabo, en si peu de, nous avons
reçu tellement de nouvelles procédures interessantes...

Une suggestion, dans la mesure du possible bien sûr, il faudrait peut-être
créer aussi un fichier zip contenant toutes les procédures d'excelabo en
PDF, pour un téléchargement rapide de tout son contenu. Il me semble que ça
ferait une belle Bible sur ma table de chevet!

Salut Michel!
t'as raison comme ça c'est limpide ;-)
enfin ... presque !
le foldstring remarque je sais toujours pas ce que c'est mais j'ai
toujours bien dormi jusqu'ici sans le savoir, j'imagine que je peux
continuer :-). Sur msdn, l'explication
"maps one string to another, performing a specified transformation
option" est compréhensible dans son titre mais dans son application, je
ne pige vraiment pas où les accents sont enlevés !
en tous cas ceci est soigneusement archivé et en fait déjà en usage sur
le classeur de mise en forme des astuces d'excelabo
Merci à vous

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 16:00, :

Bonjour Flo;
C'est la faute à Laurent qui complique à plaisir pour te perturber; au plus
simple:

Function SANSACCENTS_2(Texte As String) As String
Dim strTemp As String, C As String * 1, I As Long
strTemp = Space(Len(Texte))
FoldString &H40, Texte, -1, strTemp, Len(Texte)
For I = 1 To Len(Texte)
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS_2 = SANSACCENTS_2 & C
Next I
End Function

MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:edQdpZCFFHA.1260@TK2MSFTNGP12.phx.gbl...

En comparant la vitesse d'exécution, vos deux macros sont équivalentes
(2 sec pour traiter l'ensemble des réponses aux questions d'excelabo !)
Voilà qui m'a fait mettre immédiatement au placard ma petite fonction
avec des arrays !
Cela dit j'ai gardé celle de RD-MP, biscotte je la comprends...
Heu... t'explique là Laurent ? c'est quoi le foldstring ?

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 13:01, :

Pour compléter la collection, dans un registre tout autre que tu connais
bien... ;-)

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

Function SANSACCENTS(Texte As String) As String

Dim strTemp As String, C As String * 1
Dim cchdest As Long, I As Long
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
strTemp = Space(cchdest)
FoldString &H40, Texte, -1, strTemp, cchdest
For I = 1 To cchdest
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS = SANSACCENTS & C
Next I

End Function

Laurent

Bounjour Robert;
Ton intéressante fonction est simplifiable:

Function Sans_accents$(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
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

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

MP

"Herdet" <rdezan@noos.fr> a écrit dans le message de
news:O$hyM43EFHA.2700@TK2MSFTNGP14.phx.gbl...

Oups, une petite erreur qui oubliait les caractères non accentués et

les

chiffres

Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
car = Mid(Src, i, 1)
If InStr(1, a, car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = car Then Dest = Dest &
Mid(b, j,
1): Exit For
Next
Else
Dest = Dest & car
End If
Next
Sans_accents = Dest
'---- Testé sur 0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ
End Function

"Herdet" <rdezan@noos.fr> a écrit dans le message de news:
uQldvy3EFHA.3984@TK2MSFTNGP14.phx.gbl...

Bonjour Michel,
Une solution VBA un peu plus générale sans Select Case ni codes ASCII
A adapter
Cordialement
Robert Dezan
-------------------------------------------------------
Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
Car = Mid(Src, i, 1)
If InStr(1, a, Car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = Car Then Dest = Dest & Mid(b,

j,

1): Exit For
Next
End If
Next
Sans_accents = Dest
End Function

-----------------------------------------------------------------------

-

"Michel NOLF" <michel.nolf.sansspam@tiscali.fr> a écrit dans le

message

de

news: %237ZKbx2EFHA.3244@TK2MSFTNGP15.phx.gbl...

Bonjour à tous
Je voudrais pouvoir supprimer les accents d'une chaine de

caractères.

Il

y
a-t-il un moyen sans être obligé de passer par un select case

é,ù,î,ï

etc.
Les caractères peuvent être en LCase ou UCase.
Merci pour votre aide
Michel

Re Florence;
Oui, c'est peut être plus simple, mais c'est faux car c'est Laurent qui a
raison. La fonction sépare les caractères accentués en 2 caractères (le
caractère simple et l'accent). En conséquence, la longueur de chaîne est
forcément plus grande que la chaine Texte d'origine et la longueur de chaîne
a tester est égale à ce qu'indique Laurent dans la ligne:
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
(-1 parce que le dernier caractère de la chaîne renvoyée est un caractère de
type vbNull)
Donc mea culpa...
MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:%23z2P%23sDFFHA.3492@TK2MSFTNGP12.phx.gbl...

Salut Michel!
t'as raison comme ça c'est limpide ;-)
enfin ... presque !
le foldstring remarque je sais toujours pas ce que c'est mais j'ai
toujours bien dormi jusqu'ici sans le savoir, j'imagine que je peux
continuer :-). Sur msdn, l'explication
"maps one string to another, performing a specified transformation
option" est compréhensible dans son titre mais dans son application, je
ne pige vraiment pas où les accents sont enlevés !
en tous cas ceci est soigneusement archivé et en fait déjà en usage sur
le classeur de mise en forme des astuces d'excelabo
Merci à vous

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 16:00, :

Bonjour Flo;
C'est la faute à Laurent qui complique à plaisir pour te perturber; au
plus

simple:

Function SANSACCENTS_2(Texte As String) As String
Dim strTemp As String, C As String * 1, I As Long
strTemp = Space(Len(Texte))
FoldString &H40, Texte, -1, strTemp, Len(Texte)
For I = 1 To Len(Texte)
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS_2 = SANSACCENTS_2 & C
Next I
End Function

MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:edQdpZCFFHA.1260@TK2MSFTNGP12.phx.gbl...

En comparant la vitesse d'exécution, vos deux macros sont équivalentes
(2 sec pour traiter l'ensemble des réponses aux questions d'excelabo !)
Voilà qui m'a fait mettre immédiatement au placard ma petite fonction
avec des arrays !
Cela dit j'ai gardé celle de RD-MP, biscotte je la comprends...
Heu... t'explique là Laurent ? c'est quoi le foldstring ?

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 13:01, :

Pour compléter la collection, dans un registre tout autre que tu
connais

bien... ;-)

Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA"
_

(ByVal dwMapFlags As Byte, ByVal lpSrcStr As String, ByVal cchSrc As
Long, _
ByVal lpDestStr As String, ByVal cchdest As Long) As Long

Function SANSACCENTS(Texte As String) As String

Dim strTemp As String, C As String * 1
Dim cchdest As Long, I As Long
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
strTemp = Space(cchdest)
FoldString &H40, Texte, -1, strTemp, cchdest
For I = 1 To cchdest
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS = SANSACCENTS & C
Next I

End Function

Laurent

Bounjour Robert;
Ton intéressante fonction est simplifiable:

Function Sans_accents$(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
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

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

MP

"Herdet" <rdezan@noos.fr> a écrit dans le message de
news:O$hyM43EFHA.2700@TK2MSFTNGP14.phx.gbl...

Oups, une petite erreur qui oubliait les caractères non accentués et

les

chiffres

Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
car = Mid(Src, i, 1)
If InStr(1, a, car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = car Then Dest = Dest &
Mid(b, j,
1): Exit For
Next
Else
Dest = Dest & car
End If
Next
Sans_accents = Dest
'---- Testé sur 0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ
End Function

"Herdet" <rdezan@noos.fr> a écrit dans le message de news:
uQldvy3EFHA.3984@TK2MSFTNGP14.phx.gbl...

Bonjour Michel,
Une solution VBA un peu plus générale sans Select Case ni codes
ASCII

A adapter
Cordialement
Robert Dezan
-------------------------------------------------------
Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a = "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b = "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
Car = Mid(Src, i, 1)
If InStr(1, a, Car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = Car Then Dest = Dest &
Mid(b,

j,

1): Exit For
Next
End If
Next
Sans_accents = Dest
End Function

-----------------------------------------------------------------------

-

"Michel NOLF" <michel.nolf.sansspam@tiscali.fr> a écrit dans le

message

de

news: %237ZKbx2EFHA.3244@TK2MSFTNGP15.phx.gbl...

Bonjour à tous
Je voudrais pouvoir supprimer les accents d'une chaine de

caractères.

Il

y
a-t-il un moyen sans être obligé de passer par un select case

é,ù,î,ï

etc.
Les caractères peuvent être en LCase ou UCase.
Merci pour votre aide
Michel

re bonjour Misange,

philosophie : l'intérêt d'un site web c'est de bouger. Et puis d'être
consultable avec des outils de recherche.

Je le sais bien, mais ma plus grande peur, c'est de voir un jour partir un
site tel que le tien. Il y a tellement eu plusieurs excellents sites qui
ont disparus du web sans laisser
de trace nulle part.... Vivre dans l'insécurité de voir perdre tout ce
savoir et tout ce magnifique travail ( en Français, par surcroît )
m'angoisse! Il faut nécessairement laisser une trace quelques part. La
question est: Comment?

Combien de bouquins (si possible très très gros) as tu déjà acheté en
ayant l'impression qu'à force de les voir sur ta table de nuit, leur
contenu allait finir par rentrer tout seul dans ton crane ? Alors un de
plus ou de moins...

Moi, mes bouquins, je les loue à la bibliothèque, ou bien je les fait
acheter par mon employeur ;-), où je les imprimes via Internet....

--
Au plaisir de vous revoir ...
Visitez >> http://www.excelabo.net
Le merveilleux site de Misange
Starwing
brault-lavoieNOSPAM@sympatico.ca
--

....fût il un broutard angevin...

Ca y est ça le reprend !
Il veut encore nous refiler ses vieilles laitières de réforme

AV... ferme (acception au choix) sur la qualité !

Est-ce que je peux ajouter un grain de sel(poivre)? Après avoir tester
100000 "SansAccents" la mehode de MD est la plus rapide et la seule sans
erreur. Désolé si il ya a un motif de bisbille !!! :) (premier essai de
smiley)
amicalement michel

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:uBWJS$DFFHA.1348@TK2MSFTNGP14.phx.gbl...

Re Florence;
Oui, c'est peut être plus simple, mais c'est faux car c'est Laurent qui a
raison. La fonction sépare les caractères accentués en 2 caractères (le
caractère simple et l'accent). En conséquence, la longueur de chaîne est
forcément plus grande que la chaine Texte d'origine et la longueur de
chaîne

a tester est égale à ce qu'indique Laurent dans la ligne:
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
(-1 parce que le dernier caractère de la chaîne renvoyée est un caractère
de

type vbNull)
Donc mea culpa...
MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:%23z2P%23sDFFHA.3492@TK2MSFTNGP12.phx.gbl...

Salut Michel!
t'as raison comme ça c'est limpide ;-)
enfin ... presque !
le foldstring remarque je sais toujours pas ce que c'est mais j'ai
toujours bien dormi jusqu'ici sans le savoir, j'imagine que je peux
continuer :-). Sur msdn, l'explication
"maps one string to another, performing a specified transformation
option" est compréhensible dans son titre mais dans son application, je
ne pige vraiment pas où les accents sont enlevés !
en tous cas ceci est soigneusement archivé et en fait déjà en usage sur
le classeur de mise en forme des astuces d'excelabo
Merci à vous

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 16:00, :

Bonjour Flo;
C'est la faute à Laurent qui complique à plaisir pour te perturber; au
plus

simple:

Function SANSACCENTS_2(Texte As String) As String
Dim strTemp As String, C As String * 1, I As Long
strTemp = Space(Len(Texte))
FoldString &H40, Texte, -1, strTemp, Len(Texte)
For I = 1 To Len(Texte)
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS_2 = SANSACCENTS_2 & C
Next I
End Function

MP

"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:edQdpZCFFHA.1260@TK2MSFTNGP12.phx.gbl...

En comparant la vitesse d'exécution, vos deux macros sont équivalentes
(2 sec pour traiter l'ensemble des réponses aux questions d'excelabo
!)

Voilà qui m'a fait mettre immédiatement au placard ma petite fonction
avec des arrays !
Cela dit j'ai gardé celle de RD-MP, biscotte je la comprends...
Heu... t'explique là Laurent ? c'est quoi le foldstring ?

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 16/02/2005 13:01, :

Pour compléter la collection, dans un registre tout autre que tu
connais

bien... ;-)

Private Declare Function FoldString Lib "kernel32" Alias
"FoldStringA"

_

(ByVal dwMapFlags As Byte, ByVal lpSrcStr As String, ByVal cchSrc
As

Long, _
ByVal lpDestStr As String, ByVal cchdest As Long) As Long

Function SANSACCENTS(Texte As String) As String

Dim strTemp As String, C As String * 1
Dim cchdest As Long, I As Long
cchdest = FoldString(&H40, Texte, -1, strTemp, 0) - 1
strTemp = Space(cchdest)
FoldString &H40, Texte, -1, strTemp, cchdest
For I = 1 To cchdest
C = Mid(strTemp, I, 1)
If C Like "[!´`^¨~°¸]" Then SANSACCENTS = SANSACCENTS & C
Next I

End Function

Laurent

Bounjour Robert;
Ton intéressante fonction est simplifiable:

Function Sans_accents$(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
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

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

MP

"Herdet" <rdezan@noos.fr> a écrit dans le message de
news:O$hyM43EFHA.2700@TK2MSFTNGP14.phx.gbl...

Oups, une petite erreur qui oubliait les caractères non accentués
et

les

chiffres

Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
car = Mid(Src, i, 1)
If InStr(1, a, car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = car Then Dest = Dest &
Mid(b, j,
1): Exit For
Next
Else
Dest = Dest & car
End If
Next
Sans_accents = Dest
'---- Testé sur 0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ
End Function

"Herdet" <rdezan@noos.fr> a écrit dans le message de news:
uQldvy3EFHA.3984@TK2MSFTNGP14.phx.gbl...

Bonjour Michel,
Une solution VBA un peu plus générale sans Select Case ni codes
ASCII

A adapter
Cordialement
Robert Dezan
-------------------------------------------------------
Function Sans_accents(Chaine$) ' R. Dezan
' remplacement des caractères accentués
a "SZszYÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b "SZszYAAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Src = Chaine$
Dest = ""
For i = 1 To Len(Src)
Car = Mid(Src, i, 1)
If InStr(1, a, Car, 0) <> 0 Then
For j = 1 To Len(a)
If Mid(a, j, 1) = Car Then Dest = Dest &
Mid(b,

j,

1): Exit For
Next
End If
Next
Sans_accents = Dest
End Function

-----------------------------------------------------------------------

-

"Michel NOLF" <michel.nolf.sansspam@tiscali.fr> a écrit dans le

message

de

news: %237ZKbx2EFHA.3244@TK2MSFTNGP15.phx.gbl...

Bonjour à tous
Je voudrais pouvoir supprimer les accents d'une chaine de

caractères.

Il

y
a-t-il un moyen sans être obligé de passer par un select case

é,ù,î,ï

etc.
Les caractères peuvent être en LCase ou UCase.
Merci pour votre aide
Michel

Starwing wrote:

Moi, mes bouquins, ../.. ../.., je les imprimes via Internet....
Profites-en rapidement notre misange n'a pas encore interdit la recopie

;o)))
@+

--
Au plaisir de vous revoir ...
Visitez >> http://www.excelabo.net
Le merveilleux site de Misange
Starwing
brault-lavoieNOSPAM@sympatico.ca

Oupsss AV !!!
me semble-t-il "el argentino @ jean naimar" n'est point le broutard !!!!
je pencherai pour une Lyonnaise... ;o)))

wrote:

....fût il un broutard angevin...

Ca y est ça le reprend !
Il veut encore nous refiler ses vieilles laitières de réforme

AV... ferme (acception au choix) sur la qualité !

Salut Michel,

Est-ce que je peux ajouter un grain de sel(poivre)? Après avoir tester
100000 "SansAccents" la mehode de MD est la plus rapide et la seule sans
erreur. Désolé si il ya a un motif de bisbille !!! :) (premier essai de
smiley)

Oups, je ne savais pas qu'il s'agissait de faire des benchmarks ;-)

On peut accélérer très nettement la version "API" comme ça :

' ==========================
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

' ==========================
Pour Misange : FoldString permet de faire différentes tranformations d'une
chaîne de caractères, en particulier de scinder les caractères accentués en deux
caractères successifs (la lettre sans accent et l'accent sans lettre). Ainsi,
"Du mélèze brûle dans l'âtre" devient "Du me´le`ze bru^le dans l'a^tre". Après,
il suffit de parcourir cette chaîne en éliminant tous les accents.

Laurent