Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Résolu
julia Namor Messages postés 532 Statut Membre -  
Patrice33740 Messages postés 8930 Statut Membre -
Bonjour à tous
Je fais appel à votre aide pour simplifier et/ou modifier ce code qui fait énormément clignoter la feuille lors de son exécution.

Merci à vous 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False

 If EDITION_AGENT_PM.Visible = True Then
 
    If Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "A" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
     ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Nuit" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
     ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "M" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
      ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "J" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Ca" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = -16776961
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Fr" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = -11489280
        
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "H" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Abs" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = -16776961
       
         ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Jss" Then
        
        Target.Value = Sheets("Donnees").Range("AF1").Value
        Target.Font.Color = -16776961
        
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Sup" Then
        
        Target.Value = ""
        Target.ClearComments
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "" Then
        
         Sheets("Donnees").Range("AF1").Copy
        
       Target.Select
        Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
         Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color

      
      ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Sup2" Then
        
        Target.ClearComments
        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
     ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Hsup" Then
        
      Target.Comment.Text Text:=Sheets("AGENT_PM").Range("A10").Value

        Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
        Target.Comment.Text Text:=Sheets("AGENT_PM").Range("A10").Value
        
Target.Font.Color = Sheets("Donnees").Range("AF1").Font.Color
      
         
        ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "0" Then
        Target.Interior.Color = Sheets("Donnees").Range("Af1").Interior.Color
        
      ElseIf Not Intersect(Target, Range("$I$11:$EXV$40")) Is Nothing And Sheets("Donnees").Range("AF1").Value = "Supp3" Then
        Target.Interior.Color = Sheets("Donnees").Range("Af1").Interior.Color
        
     End If
        
    End If
        
    
Application.ScreenUpdating = True
End Sub


EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.



4 réponses

Réponse 1 / 4
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Bonjour,

Tu devrais commencer par interrompre les évènements pendant ta macro
0
Réponse 2 / 4
julia Namor Messages postés 532 Statut Membre 33
 
Merci Patrice33740

Est ce bien avec "application.enableevents = false" que tu me suggéres d'interrompre les événement?

ou devrais je les placer?
0
Réponse 3 / 4
julia Namor Messages postés 532 Statut Membre 33
 
dont acte
méa culpa
0
Réponse 4 / 4
julia Namor Messages postés 532 Statut Membre 33
 
Merci Patrice33740

Est ce bien avec "application.enableevents = false" que tu me suggéres d'interrompre les événement?

ou devrais je les placer?
0
Patrice33740 Messages postés 8930 Statut Membre 1 781
 
Re,

Oui,

Au choix,
- tu les places avant chaque instruction qui génère un évènement (dans ton cas, chaque écriture de cellule) et surtout tu fait suivre de Application.EnableEvents = True.
- tu le places en début de procédure et tu termines par Application.EnableEvents = True avant le End Sub
0

Discussions similaires

input signal out of range
marlene -
usman000 -

14 réponses
Problème d'allumage écran LG : "OUT OF RANGE"
roblaf -
MathiaMan25 -

3 réponses
Ecran noir avec 'out of range" sous windows 10
SAPHIR13600 -
SAPHIR13600 -

5 réponses
comment désactiver out of range
lzri98 -
jeannets -

3 réponses
Problème écran "out of range" au démarrage
Nast79 -
cathy -

8 réponses