Option Explicit
'Remplacé par PatrickToulon
Private Const accent As String = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿ ÑñÇç'-"
Private Const noAccent As String = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuy NnCc "
Sub Accents_Killer()
Dim Cell As Range
Dim Response As Long, rng As Range, Lastrow
Lastrow = ActiveSheet.UsedRange.Rows.Count
Set rng = Selection
If rng.Columns.Count > 1 Then MsgBox "Ne pas seléctionner 2 colonnes à la fois", vbExclamation, "Une Colonne à la fois !": Exit Sub
If rng.Rows.Count >= Rows.Count Then Set rng = rng.Cells(2, 1).Resize(Lastrow)
'>>>Ajout Thierry 20200501
If rng.Rows.Count > 1000 Then
Response = MsgBox("Ca va prendre du temps sur : " & Format(Selection.Rows.Count, "#0,000,000") & " Cellules" & vbCrLf & "Voulez-vous continuer ?", vbOKCancel)
If Response = vbCancel Then Exit Sub
ElseIf rng.Rows.Count <= 1 Then
MsgBox "Vous devez sélectionner une plage pour appliquer cette macro", vbInformation
Exit Sub
End If
'<<<
For Each Cell In rng.Cells
Cell.Value = SansAccents(Cell.Text)
Next Cell
End Sub
' La fonction :
Public 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