XL 2019 Nom et Prenom sans accent avec MID

[carlos]

Bonjour,
J'aimerais changer le "ï" en "i" mais j'ai un message d'erreur sur ce code :
Sub Accents3()
Dim F3NomPrenom As String
Dim ch_avec As String: Dim ch_sans As String
'On Error Resume Next
Dim I As Byte: Dim position As Integer
F3NomPrenom = "Dupont Loïs"
ch_avec = "ÉÈÊËÔéèêëàçùôûïî+-."
ch_sans = "EEEEOeeeeacuouii "
For I = 1 To Len(F3NomPrenom)
position = InStr(ch_avec, VBA.Mid(F3NomPrenom, I, 1))
If position > 0 Then
VBA.Mid(F3NomPrenom, I, 1) = VBA.Mid(ch_sans, position, 1)
End If
Next I
F3NomPrenom = Application.Substitute(F3NomPrenom, " ", "")
F3NomPrenom = Application.Substitute(F3NomPrenom, ".", "")
End Sub

Et comment récupérer le nom prenom sans accent?
Pourrie vous m'aider?
Bien à vous

 

[carlos]

Re,
je pense avoir trouové laraison :
Il faut remplacer VBA.MID par MID
Bonne journée

 

[job75]

Bonjour carlos, le forum,

Et comment récupérer le nom prenom sans accent?

A la fin de votre macro :

For I = 1 To Len(ch_avec)
    F3NomPrenom = Replace(F3NomPrenom, Mid(ch_avec, I), Mid(ch_sans, I))
Next I
MsgBox F3NomPrenom

A+

 

[Dudu2]

Bonjour,
A titre d'info dans mes applis j'utilise cette fonction faite il y a longtemps.

'-----------------------------------------------
'Épuration d'une chaine des caractères accentués
'-----------------------------------------------
Private Function ÉpurerChaine(Chaine As String) As String
    Const LettresDiacritiques = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝŸàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    Const LettresNormales = "AAAAAACEEEEIIIINOOOOOUUUUYYaaaaaaceeeeiiiinooooouuuuyy"
    Dim i As Integer
    Dim k As Integer
    Dim S As String
  
    S = Chaine
  
    For i = 1 To Len(S)
        k = InStr(LettresDiacritiques, Mid(S, i, 1))
        If k Then Mid(S, i, 1) = Mid(LettresNormales, k, 1)
    Next i
  
    ÉpurerChaine = S
End Function

 

[crocrocro]

Bonjour à tous,
les réponses se croisent,
voici un groupe de fonctions qui permettent de formater une chaine de caractères passée en entrée. A combiner selon les besoins.
La fonction Sans_Accent je pense, correspond à celle de Dudu.

Function Sans_Point(pChaine As String) As String
' pour tous les "mots" finissant par ".", on remplace par " "
' ex : Mot1. Mot2. suite et fin
'   -> Mot1  Mot2  suite et fin
Dim Mot As Variant
Dim i As Integer
  Mot = Split(pChaine, " ")
  For i = LBound(Mot) To UBound(Mot)
    If Right(Mot(i), 1) = "." Then Mot(i) = Left(Mot(i), Len(Mot(i)) - 1)
  Next i
  Sans_Point = Join(Mot, " ")
End Function
Function Epure(pChaine As String) As String

Dim Chaine As String

    ' remplacement des caractères accentués
    Chaine = pChaine
    Epure = Sans_Accent(Chaine)
    ' suppression des caractères autres que numériques (0,1,2,...9) qu'alphabétiques non accentués (a,b,...z A,B,...Z)
    Epure = Sans_Special(Chaine)
    
End Function

Function Sans_Accent(pChaine As String) As String
Dim ListeAccent As String
Dim ListeSansAccent As String
Dim i As Integer
Dim pos
Dim Chaine As String

    ' remplacement des caractères accentués
    ListeAccent = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
    ListeSansAccent = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
    For i = 1 To Len(pChaine)
        pos = InStr(1, ListeAccent, Mid(pChaine, i, 1), 0)
        If pos > 0 Then
            Mid(pChaine, i, 1) = Mid(ListeSansAccent, pos, 1)
        End If
    Next i
    Sans_Accent = pChaine
    
End Function
Public Function Sans_Special(pChaine As String) As String
Dim i As Integer
Dim j As Integer
Dim Chaine As String
    ' suppression des caractères autres que numériques (0,1,2,...9) qu'alphabétiques non accentués (a,b,...z A,B,...Z)
    j = 0
    Chaine = ""
    For i = 1 To Len(pChaine)
        If ( _
            (Asc(Mid(pChaine, i, 1)) >= Asc("a")) And (Asc(Mid(pChaine, i, 1)) <= Asc("z")) Or _
            (Asc(Mid(pChaine, i, 1)) >= Asc("A")) And (Asc(Mid(pChaine, i, 1)) <= Asc("Z")) Or _
            (Asc(Mid(pChaine, i, 1)) >= Asc("0")) And (Asc(Mid(pChaine, i, 1)) <= Asc("9")) Or _
            (Mid(pChaine, i, 1) = " ") _
            ) _
        Then
            j = j + 1
            Chaine = Chaine & Mid(pChaine, i, 1)
        Else
        End If
    Next i
    Sans_Special = Chaine
End Function