Supprimer Accent

15sans-accent.xlsm (16.79 Ko)

Bonjour tout le monde,

Je viens vers vous concernant une demande sur une suppression d'accent ... Je tourne un peu en rond j'arrive à le faire de manière automatique sur toute la feuille dès que je rentre mon mot mais j'aimerais en fait réussir à ne le faire que sur une "Range" et sur ça je bloque ...

J'ai fait un module contenant :

Function sansAccent(mot As String)

    Dim listeAccents  As String, listeLettres As String
    listeAccents = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðòóôõöùúûüýÿ"
    listeLettres = "AAAAAACEEEEIIIIOOOOOUUUUYaaaaaaceeeeiiiioooooouuuuyy"

    Dim i As Integer
    For i = 1 To Len(listeAccents)
        mot = Replace(mot, Mid(listeAccents, i, 1), Mid(listeLettres, i, 1))
    Next

    sansAccent = mot

End Function

Et sur ma feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        Target.Formula = sansAccent(Target.Formula)
    End If
End Sub

Mais bon comme je le dis ça s'applique sur toute ma feuille sauf que j'aimerais que ce soit limité de A1 à A15 (et dans le meilleur des cas passer même par le Row.Count.End(xlUp) en partant de A8 par exemple.

Merci d'avance à vous et bonne journée,

Cordialement,

Salut, tu peux cibler ton target contrôler avec une condition comme ci-dessous :

If Not Intersect(Target, Me.Range("A1:A15")) Is Nothing Then

et si tu veux passer par ton truc :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And (Not Intersect(Target, Me.Range("A8", Me.Range("A" & Me.Row.Count.End(xlUp).Row))) Is Nothing) Then
        Target.Formula = sansAccent(Target.Formula)
    End If
End Sub

La condition vérifier est désormais si la modification est 1 cellule compris entre A8 et A dernière ligne.

Je l'ai pas essayé mais normalement ça devrait le faire ;)

Salut tenders_vba,

Après essai ça ne fonctionne pas de mon côté

Je suis paumé en vrai dans ce code haha pourtant je tente pleins de trucs

Merci à toi !

Bonjour,

Un test :

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Count = 1 And Not Application.Intersect(Target, Me.Range("A8:A" & Me.Cells(Me.Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
        Target.Formula = sansAccent(Target.Formula)
    End If
    Application.EnableEvents = True
End Sub

Il y avait une boucle infinie, en effet ta fonction de remplacement des caractères redéclanchait à l'infini la macro worksheet change que j'ai désactivé à l'aide de la propriété enableevents.

Cdlt,

Tiens je t'ai fait un petit fichier, il y avait un problème de boucles infinies

20demo.xlsm (21.83 Ko)

[EDIT] : Ah bah cela a déjà été dit

J'ai modifié aussi la dernière ligne de A (c'était pas très beau avant) par : Me.Range("A8", Me.Range("A" & Me.Rows.Count).End(xlUp))

J'ai une autre petite question sans rapport avec ce code mais lorsque je fais :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Matiere As Range
Dim cell As Range

Set Matiere = Me.Range("A8", Me.Range("A" & Me.Rows.Count).End(xlUp))

For Each cell In Matiere
    cell = UCase(cell)
Next

End Sub

J'ai bien sélectionné la partie avec le A8 comme dans vos formules mais le problème c'est qu'il me met aussi en majuscule la case A7 je suis troublé lol

En tout cas merci pour vos formules à tous les deux ça fonctionne bien ;)

[EDIT] : Ah bah je viens de voir qu'il supprime aussi les accents ... J'avoue que je comprends pas trop pourquoi

Bonjour,

Avec ton dernier code si je mets A7 en minuscule il ne me le repasse pas en majuscule.

Après je me demande l'intérêt de repasser à travers toute la plage matière sachant que ta macro s'active à chaque changement, toutes les autres valeurs de la range sont déjà en majuscule. C'est une surconsommation inutile et contre productif, autant se limiter à UCase(Target).

Cdlt,

Ergotamine,

Je veux bien que tu m'expliques

Je suis encore assez novice sur VBA donc j'avoue ne pas trop comprendre ton message, tu me dis t'intégrer directement le UCase dans la macro que vous m'avez envoyé précédemment ?

Merci à toi !

Bonjour,

Je veux dire comme le fichier joint.

Il est inutile de repasser toutes tes valeurs de ta plage en majuscule car elles ont normalement été déjà transformées au préalable individuellement par ta macro Worksheet_Change. C'est comme si tu faisais remplacer toutes tes cellules par 1 alors qu'elle contiennent déjà 1 sauf la dernière cellule que tu viens de modifier qui elle contient une autre valeur. Dans ce cas autant se limiter au remplacement sur cette cellule, d'où le Target.

J'espère que c'est plus clair désormais.

Cdlt,

Ergotamine,

En fait, j'avais commencé par faire une première macro pour passer mes cellules de A8 à A15 en Majuscules puis je me suis attaqué à trouver comment supprimer les accents car passer en majuscule ne le fait pas et donc j'ai fait une nouvelle macro pour les accents, je n'ai pas pensé au fait de pouvoir combiner les deux, j'avais peur que la range n'appliquerait que la suppression d'accent

Mais tu me sauves de la consommation et allège mon code merci beaucoup à toi !

Pour information si cela change la cellule A7 :

Me.Range("A8", Me.Range("A" & Me.Rows.Count).End(xlUp))

Prend la Range de A8 à dernière cellule de la colonne A contenant quelques choses, Si tu as rien après A6 il va prendre la range "A6:A8".

Il faut donc au moins que tu ais quelques choses dans A8 et que tout ce que tu veux changer se trouve en dessous de ce A8. Ou que tu rajoutes une vérification à ton code en vérifiant que tu te trouves sous A8 comme un :

And (Target.row > 8)
Rechercher des sujets similaires à "supprimer accent"