Sortir d'une chaine un mot contenant des accents

Question

Bonjour à tous,
Tout nouveau ici.
Je travaille sur Access 2003. 

Dans une table j'aimerai extraire tous les mots contenant un accent ou plusieurs fois le même ou plusieurs accents différents ("é" "è" "ò" "ù" "à" "ç" "â" "ê" "î" "ô" "û" "ä" ë" "ï" "ö" "ü"). 
Normalement ces mots se trouvent entre deux espaces vides sauf s'ils sont placés en début ou fin de chaine. Exemple ", (écône), " ou ", (écône, xxx)"
Une fois extrait ces mots doivent être écris dans une autre table [tag].
la table [tag] comprend
ID
Accent
sansaccent

Le mot avec accent sous [tag].[accent] = si possible "écone" sinon "(écône)," m'irait aussi (me resterait plus qu'à faire une requête pour enlever parenthèses et virgule superflues.
et crée le mot sans accent sous [tag].[sansaccent] = "econe" ou sinon "(econe),"

J'ai cherché longtemps sous se site mais pas trouvé exactement un VBA correspondant à ma requête.

Merci d'avance pour votre aide et bonne journée
Frédéric

cs_Le Pivert · Answer

Bonjour,

en vba, voilà le code pour détecter les mots accentués. Je ne connais pas Access, il vous suffit de récupérer le mot et le copier où vous voulez

Option Explicit
Dim mot As String
Private Sub CommandButton1_Click()
 extractionMots
End Sub
'Extraire les données séparées par un espace dans une chaine de caractères
Sub extractionMots()
Dim Chaine As String
Dim Tableau() As String
Dim i As Integer
    Chaine = "Retrouver les caractères accentués dans une chaîne"
    'découpe la chaine en fonction des espaces " "
    'le résultat de la fonction Split est stocké dans un tableau
    Tableau = Split(Chaine, " ")
    
    'boucle sur le tableau pour visualiser le résultat
    For i = 0 To UBound(Tableau)
        'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
        mot = Tableau(i)
        SupprimerAccents (mot)
       Next i
   End Sub
Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    sTmp = sChaine
    For i = 1 To Len(sTmp)
        p = InStr(sCarAccent, Mid(sTmp, i, 1))
          If p > 0 Then
           MsgBox mot 'mettre le code pour copier le mot dans une autre table [tag]
          End If
        If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
   ' SupprimerAccents = sTmp
End Function

Sortir d'une chaine un mot contenant des accents

1 réponse

Discussions similaires

Newsletters