XL 2019 Optimiser une macro

[pat66]

Bonjour le forum,
depuis que j'ai bricolé, car mes connaissances sont limitées, et ajouté cette macro, mon écran scintille on sent que ça mouline, auriez la gentillesse de me dire si c'est possible de l'éviter, ou de me donner un conseil, voici la macro qui est sur la feuille "DSI"
merci pour votre aide
Pat66

Private Sub Worksheet_Change(ByVal target As Range)
Application.ScreenUpdating = False
If Worksheets("D.S.I").Range("G153") = "oui" Then
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").Visible = True
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 94").Visible = False
Worksheets("Total Eco Imp.").Unprotect ("SC6")
Worksheets("Total Eco Imp. (1)").Unprotect ("SC6")
Sheets("Total Eco Imp.").Range("CP18,CP19,CP20,CP21,CP22,CP23").FormulaLocal = "=-W$312*2%"
Sheets("Total Eco Imp.").Range("CP24,CP25,CP26").FormulaLocal = "=-W$312*2%"
Sheets("Total Eco Imp.").Range("CP27,CP28,CP29").FormulaLocal = "=-W$312*1%"
Sheets("Total Eco Imp. (1)").Range("CP18,CP19,CP20,CP21,CP22,CP23").FormulaLocal = "=-W$312*2%"
Sheets("Total Eco Imp. (1)").Range("CP24,CP25,CP26").FormulaLocal = "=-W$312*2%"
Sheets("Total Eco Imp. (1)").Range("CP27,CP28,CP29").FormulaLocal = "=-W$312*1%"
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").Fill.ForeColor.RGB = RGB(255, 192, 0)   ' ou DrawingObject.Interior.Color = RGB(255, 192, 0)
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").TextFrame.Characters.Font.Color = RGB(0, 32, 96)
Worksheets("Planning Treso").Shapes("2022").Visible = False
Worksheets("Planning Treso").Shapes("Ellipse 5").Visible = False
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Worksheets("Total Eco Imp.").Unprotect ("SC6")
Worksheets("Total Eco Imp. (1)").Unprotect ("SC6")
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").Visible = False
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 94").Visible = True
Sheets("Total Eco Imp.").Range("CP18,CP19,CP20,CP21,CP22,CP23").FormulaLocal = "=-W$312*1,75%"
Sheets("Total Eco Imp.").Range("CP24,CP25,CP26").FormulaLocal = "=-W$312*1,50%"
Sheets("Total Eco Imp.").Range("CP27,CP28,CP29").FormulaLocal = "=-W$312*0,833%"
Sheets("Total Eco Imp. (1)").Range("CP18,CP19,CP20,CP21,CP22,CP23").FormulaLocal = "=-W$312*1,75%"
Sheets("Total Eco Imp. (1)").Range("CP24,CP25,CP26").FormulaLocal = "=-W$312*1,50%"
Sheets("Total Eco Imp. (1)").Range("CP27,CP28,CP29").FormulaLocal = "=-W$312*0,833%"
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 94").DrawingObject.Interior.Color = RGB(255, 192, 0)  ' DrawingObject.Interior.ColorIndex = xlNone   ' ou DrawingObject.Interior.Color = RGB(255, 192, 0)
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 94").TextFrame.Characters.Font.Color = RGB(0, 32, 96)
Worksheets("Total Eco Imp.").Protect ("SC6")
Worksheets("Total Eco Imp. (1)").Protect ("SC6")
End If
Application.ScreenUpdating = True
End Sub

 

[sylvanu]

Bonjour Pat,
Pour afficher le code "en code" utilisez la balise </> ( à droite de l'icone GIF.)
C'est mieux quand on dispose d'un fichier test, c'est plus représentatif.
En PJ j'ai essayé de recréer votre contexte, et en modifiant G153 de D.S.I. je n'observe pas de scintillement et le code "ne mouline pas" l'action est immédiate.
Essayez cette PJ ou envoyez un fichier plus représentatif car le scintillement peut être dû à quelque chose d'autres ( nombreuses formules, autre macro exécutables .... )

 

[pat66]

Bonjour Sylvanu,

ok et je présume que si tu n'as rien remarqué d'anormal dans le code , c'est qu'il est normalement constitué

en tout cas merci de ton aide

 

[sylvanu]

c'est qu'il est normalement constitué

J'ai juste remplacé 1% par 0.01 car ça générait une erreur mais comme ce n'était pas l'objet je ne me suis pas appesanti sur le problème.
Mais est ce que vous observez un scintillement avec ma PJ ? car c'était l'objet du fil.

Après on peut simplifier l'écriture, mais ça ne change pas le fonctionnement, par ex :

Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").Fill.ForeColor.RGB = RGB(255, 192, 0) ' ou DrawingObject.Interior.Color = RGB(255, 192, 0)
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").TextFrame.Characters.Font.Color = RGB(0, 32, 96)
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 93").Visible = True
Worksheets("Planning Treso").Shapes("Rectangle : coins arrondis 94").Visible = False
Worksheets("Planning Treso").Shapes("2022").Visible = False
Worksheets("Planning Treso").Shapes("Ellipse 5").Visible = False

peut être remplacé par :

With Worksheets("Planning Treso")
    .Shapes("Rectangle : coins arrondis 93").Fill.ForeColor.RGB = RGB(255, 192, 0) ' ou DrawingObject.Interior.Color = RGB(255, 192, 0)
    .Shapes("Rectangle : coins arrondis 93").TextFrame.Characters.Font.Color = RGB(0, 32, 96)
    .Shapes("Rectangle : coins arrondis 93").Visible = True
    .Shapes("Rectangle : coins arrondis 94").Visible = False
    .Shapes("2022").Visible = False
    .Shapes("Ellipse 5").Visible = False
End With

Ce qui est plus lisible. Mais ce n'est que du "cosmétique".

 

[pat66]

re,

merci du conseil, sinon non votre la macro est rapide, je ne comprends pas avec la même macro en désactivant toutes les autres macros de la feuille, j'ai quand même un scintillement de quelques millisecondes

 

[sylvanu]

Au hasard, essayez de remplacez :
Ca :

Application.ScreenUpdating = false

par ça :

Application.ScreenUpdating = false
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

et en sortant, ça :

Application.ScreenUpdating = true

par ça :

Application.ScreenUpdating =True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Ca fige l'écran, invalide le calcul automatique et interdit toute autre macro. A la fin on rétablit.

PS : je suis sous XL2007, peut être ce n'est pas visible sous 2007 mais l'est sous 2019 !

 

[pat66]

ha oui, c'est très efficace, merci, le scintillement a vraiment diminué

 

[pat66]

pendant la macro , je crois apercevoir la feuille ("Total Eco Imp.")

 

[sylvanu]

pendant la macro , je crois apercevoir la feuille ("Total Eco Imp.")

Cela ne semble pas provenir de cette macro.
Pour le vérifier, enregistrez votre fichier sous un nom bidon, sélectionnez tout TotalEcoEmp. et mettez fond rouge sur toute la page, cela devrait être plus visible au test.

 

[pat66]

j'ai suivi vos conseil avec le rouge et c'est bien cette feuille qui apparait pendant le scintillement ?
et sur cette même feuille DSI, j'ai aussi une macro avec le même scintillement, alors que ("Total Eco Imp.") n'apparait nulle part ??

Sub resetDSI()
Application.ScreenUpdating = False
Worksheets("D.S.I").Unprotect Password:="SC6"
Worksheets("D.S.I").Range("J33: L33 , J34: L34 , J35: L35 , J36: L36 , J37: L37 , J38: L38 , J39: L39 , J41: L41 , J44: L44 , J47: L47 , P35, P36").ClearContents
Worksheets("D.S.I").Protect Password:="SC6"
Worksheets("D.S.I").Activate
Range("F33").Select
Application.ScreenUpdating = True
End Sub

 

[pat66]

à force de tester, j'ai désactivé dans macro post #1, la reprotection des feuilles suivantes :
'Worksheets("Total Eco Imp.").Protect ("SC6")
'Worksheets("Total Eco Imp. (1)").Protect ("SC6")

et le scintillement est à peine visible

et si je supprime dans la même macro post #1 à tout ce qui se rapporte à ("Total Eco Imp.") et ("Total Eco Imp. (1), la macro est encore plus rapide

 

[sylvanu]

Petit rappel :

Pour afficher le code "en code" utilisez la balise </> ( à droite de l'icone GIF.)

C'est vraiment plus lisible.


Il n'y a aucune raison pour que cela se produire.
Sans votre fichier difficile d'analyser.
Une solution de bourrin en aveugle :

Sub resetDSI()
Application.ScreenUpdating = False
Worksheets("Total Eco Imp.").Visible = 0    ' masque la feuille
Worksheets("D.S.I").Unprotect Password:="SC6"
Worksheets("D.S.I").Range("J33: L33 , J34: L34 , J35: L35 , J36: L36 , J37: L37 , J38: L38 , J39: L39 , J41: L41 , J44: L44 , J47: L47 , P35, P36").ClearContents
Worksheets("D.S.I").Protect Password:="SC6"
Worksheets("D.S.I").Activate
Range("F33").Select
Worksheets("Total Eco Imp.").Visible = 1    ' démasque la feuille
Application.ScreenUpdating = True
End Sub

On masque cette feuille et à la fin on la démasque.

 

[pat66]

oui désolé, je n'y suis pas arrivé à mettre les codes, sinon oui la macro est plus rapide et je n'ai plus de scintillement, voici le récap des modifications :
- j'ai ajouté comme vous me l'avez suggéré
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

et j'ai supprimé les reprotections des Worksheets("Total Eco Imp.") et les ais placé sur chaque feuille avec activate

un grand merci Sylvanu pour votre aide