Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Résolu
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

  1. Bonjour,

    Tu devrais commencer par interrompre les évènements pendant ta macro
    0
    1. 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
      1. dont acte
        méa culpa
        0
        1. 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
          1. 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