Discussion :

[babemagus]

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

[joe.levrai]

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é

[clementmarcotte]

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.

[babemagus]

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.)

[Marc-L]

Bonjour,

à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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