Bonjour,

Je viens de terminer (avec beaucoup d’aide venant de ce forum donc merci bc) une macro dont l’objectif est de récupérer le contenue de cellule nommé et de les transférer dans une fichier word en les espaçant par une tabulation.

Mon souci ici est un souci d’optimisation de temps de traitement.
En effet j’ai à tester (et à remplacer) si ma cellule contient des accents.

J’ai trouvé un code sur le forum : (auquel j’ai rajouté 2 – 3 truc dont le trait demi cadratin)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
 
Function Sans_accents$(Chaine$)  ' R. Dezan + Michel Pierron Cette fonction enlève également les OE, oe, Æ, æ qui posent un problème sur les sytèmes anglais.
 ' remplacement des caractères accentués
 a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
 b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
 Chaine = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Chaine, "oe", "oe"), "OE", "OE"), "æ", "ae"), "Æ", "AE"), "n°", "No"), "N°", "No"), "°", "deg "), "#", "diese "), "œ", "oe"), "-", "-"), " ;", ";"), "; ", ";")
 For i% = 1 To Len(Chaine)
 u% = InStr(1, a, Mid(Chaine, i, 1), 0)
 If u Then Mid(Chaine, i, 1) = Mid(b, u, 1)
 Next i
Sans_accents = Chaine
 
 End Function
Maintenant, et c’est là que je tente d’optimiser, j’applique cette fonction Sans_accents a chaque fois que je récupère le contenue d’une cellule en la remplaçant par le contenu de cette cellule une fois la fonction appliqué : (cela s’applique a 35 cellules par onglet)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Dim nombreFI As Integer
Dim tabl(39) As String
Dim Appli As Word.Application
Dim WordDoc As Word.Document
 
For j = 2 To nombreFI
Worksheets(j).Select
WdApp.Visible = False
Excel.ActiveSheet.Range(tabl(i)) = Sans_accents$(Excel.ActiveSheet.Range(tabl(i)))
 [...] ‘ il y a beaucoup de code répétitif ici mais peu d’impact sur le temps de traitement total
Letexte = UCase(Excel.ActiveSheet.Range(tabl(i)))
With WdApp
.Selection.typetext Text:=CStr(Letexte) + vbTab
End With
    End If
Ma question est de savoir s’il existe un meilleur moyen d’appliquer cette fonction qui supprime (remplace) les accents ?
(Peut être sous word une fois le doc word terminé?)

Je peux mettre le code complet en cas de besoin