Remplacer les Accents par Sans Accents

Bonsoir Tous le Monde,

Besoin de votre Aide S.V.P.

Dans un classeur, j'ai 9 colonnes et environ 8,000 lignes.

Y a-t-il un moyen de remplacer les mots avec accents sans les accents de façon rapide? (Macro, Formule ou Autre)

Ex: Téléphone remplacer par Telephone.

Merci Beaucoup.

Jean

Bonsoir

Place ce code (de Ti) dans un module et lance la macro EnleAccent

Function MajSansAccent$(ByVal Chaine$)
'Ti
Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûü", VSsAccent = "aaaaaaeeeeiiiioooooouuuu"
Dim Bcle&
If Len(Chaine) > 0 Then
For Bcle = 1 To Len(VAccent)
Chaine = Replace(Chaine, Mid(VAccent, Bcle, 1), Mid(VSsAccent, Bcle, 1))
Next Bcle
MajSansAccent = Chaine
End If
End Function

Sub EnleveAccent()
Application.ScreenUpdating = False
Dim c As Range
For Each c In Range("A1:I8000")
c = MajSansAccent(c)
Next c
End Sub

Amicalement

Nad

Bonsoir Nad,

J'ai essayé votre Code et ça n'a pas fonctionné.

J'ai trouvé ce code sur le Forum et il fonctionne. Sauf, que je suis obligé de faire la sélection des

cellules que j'ai besoin de corriger.

J'ai vu ds votre code que les cellules sont sélectionnées par défaut. For Each c In Range("A1:I8000")

Est-ce que je peux l'adapter à ce code:

Merci Beaucoup de Votre Aide.

Jean

PLACER DANS UN MODULE

Option Explicit
'Définition de la Conversion'
Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç"
Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc"
'La Fonction'
Private Function sansAccents(ByRef s As String) As String
Dim i As Integer
Dim lettre As String * 1
sansAccents = s
For i = 1 To Len(accent)
lettre = Mid$(accent, i, 1)
If InStr(sansAccents, lettre) > 0 Then
sansAccents = Replace(sansAccents, lettre, Mid$(noAccent, i, 1))
End If
Next i
End Function
Public Sub Oter_Les_Accents()
Dim c As Range
If TypeName(Selection) <> "Range" Then
MsgBox "VOUS NE POUVEZ UTILISER CETTE MACRO QUE SUR UNE SÉLECTION DE CELLULE!", vbExclamation, "Oter Les Accents"
Else
For Each c In Selection
If TypeName(c.Value) = "String" Then
If InStr(1, c.Text, "@") > 0 Then
'Adresse Mail en Minuscule sans Accent'
c = LCase(sansAccents(c.Text))
Else
'Le Reste en Majuscule Sans Accent'
c = UCase(sansAccents(c.Text))
End If
End If
Next
End If
End Sub