Optimisation de Code VBA pour Excel 2010

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:

---

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:

---

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

Bonjour,

ça peut se faire comme ceci dans word :

1) désactiver l'option "caractères accentués en majuscule" (formulation reprise de tête, c'est peut être présenté un peu différemment)
2) Ctrl+A pour tout sélectionner
3) MAJ+F3 pour tout mettre en majuscule
4) MAJ+F3 pour tout remettre en minuscule

les accents ont disparus ... normalement les majuscules standards (noms propres du dictionnaire word + début de phrase) se remettent

probablement possible par macro, mais je n'ai jamais cherché

Puisque tu veux absolument mépriser ta langue, as-tu juste essayé de changer la langue de ton document Word en anglais au lieu de français. En principe, le mépris du français devrait être total.

Ce n'est pas une seulement une soucis d'accès (bien que cela m'enlève beaucoup de soucis).
en fait je crois inclus ce que j'ai dans le doc WORD dans une base de donnée et cette BDD ne prend pas les accès pour raison d'optimisation (ne pas crier, je ne peux changer cette base).

Le ALT F3 est une bonne chose, mais il me manque les oe , les ° changé en def, etc..

C'est pour ça que je cherche à optimiser l'exécution du code (ou le code en lui même.)

Bonjour,

à tester :

Code:

---

1 2 3 4 5 6 7 8 9

Function Sans_accent$(ByVal CHAINE$) AC = Split("À Á Â Ã Ä Å È É Ê Ë Ì Í Î Ï Ñ Ò Ó Ô Õ Ö Ù Ú Û Ü Ý à á â ã ä å è é ê ë ì í î ï ð ñ ò ó ô õ ö ù ú û ü ý ÿ æ Æ œ n°") SA = Split("A A A A A A E E E E I I I I N O O O O O U U U U Y a a a a a a e e e e i i i i o n o o o o o u u u u y y ae AE oe No") For N& = 0 To UBound(AC): CHAINE = Replace$(CHAINE, AC(N), SA(N)): Next AC = [{"°","#"," ;","; "}] SA = [{"deg ","diese ",";",";"}] For N = 1 To UBound(AC): CHAINE = Replace$(CHAINE, AC(N), SA(N)): Next Sans_accent = CHAINE End Function

---

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse