XL 2010 Court-circuiter des macros événementielles

[Magic_Doctor]

Bonsoir,

J'ai 4 cellules liées, chacune, à une macro événementielle.
Sur la PJ tout est très clair, je ne rentrerai donc pas dans des explications absconses et abrutissantes.
Le problème est le suivant : quand je clique sur une cellule qui n'est pas jaune, tous les intitulés des cellules jaunes (à gauche de celles-ci) sont verts. Quand tous ces intitulés sont verts, je voudrais qu'alors toutes les macros événementielles, qui se déclenchent quand on clique sur toute autre cellule qui ne soit pas jaune, deviennent inactives.
Pourquoi ? Sur la feuille ce n'est pas visible, en revanche dans mon projet où il y a "un montón" (un paquet) de macros événementielles, ça ralenti singulièrement les calculs (hors cellules jaunes...) pour des raisons évidentes.
J'ai bien tenté en bidouillant avec la macro "CheckColor" (Módulo1), mais sans succès.
Comment s'y prendre ?

 

[Magic_Doctor]

Bon, j'ai bidouillé un truc bien lourd...

 

[Magic_Doctor]

Pas rafraîchi l'écran, nos posts se sont croisés.
J'avais complètement oublié cette histoire de cellules fusionnées.
Ça a l'air de marcher, mais la syntaxe est pithécanthropienne.

 

[job75]

Re,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Set r = [C3,C5,G3,G5]
r.Interior.Color = 13434879 'jaune pâle
With [B3,B5,E3,E5]
  .Value = "UX/1UY"
  .Interior.Color = 3899904 'vert
  .Font.Color = 49407 'orange
  .HorizontalAlignment = xlCenter
End With
If Intersect(Target, r) Is Nothing Then Exit Sub
For Each r In r
  If Not Intersect(Target, r) Is Nothing Then
    r.Interior.Color = 16777215 'blanc
    With r(1, 0).MergeArea
      .Value = "UX/1UY désiré"
      .Interior.Color = 6634265 'bleu
      .Font.Color = 65535 'jaune
      .HorizontalAlignment = xlLeft
    End With
  End If
Next
End Sub

A+

 

[Magic_Doctor]

En effet, ça change !

Encore merci job pour ton aide.

Buenas noches

PJ pour les curieux.

 

[job75]

Bonjour Magic_Doctor, le forum,

Ceci est un peu mieux :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Set r = [C3,C5,G3,G5]
r.Interior.Color = 13434879 'jaune pâle
With [B3,B5,E3,E5]
  .Value = "UX/1UY"
  .Interior.Color = 3899904 'vert
  .Font.Color = 49407 'orange
  .HorizontalAlignment = xlCenter
End With
Set r = Intersect(Target, r)
If r Is Nothing Then Exit Sub
For Each r In r 'si sélection multiple
  r.Interior.Color = 16777215 'blanc
  With r(1, 0).MergeArea
    .Value = "UX/1UY désiré"
    .Interior.Color = 6634265 'bleu
    .Font.Color = 65535 'jaune
    .HorizontalAlignment = xlLeft
  End With
Next
End Sub

Bonne journée.

 

[job75]

Re,

Enfin, pour le fun, une solution sans boucle et sans variable :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With [C3,C5,G3,G5]
  .Interior.Color = 13434879 'jaune pâle
  With Intersect(.EntireRow, [B:B,E:E])
    .Value = "UX/1UY"
    .Interior.Color = 3899904 'vert
    .Font.Color = 49407 'orange
    .HorizontalAlignment = xlCenter
  End With
  On Error Resume Next
  With Intersect(Target, .Cells)
    .Interior.Color = 16777215 'blanc
    With Intersect(Union(.Offset(, -1), .Offset(, -2)), [B:B,E:E])
      .Value = "UX/1UY désiré"
      .Interior.Color = 6634265 'bleu
      .Font.Color = 65535 'jaune
      .HorizontalAlignment = xlLeft
    End With
  End With
End With
End Sub

Mais il ne faut pas de cellules jaunes à gauche de la colonne C.

A+

 

[Magic_Doctor]

Bonsoir job,

Je viens de voir ton message.
J'ai fait quelques essais avec tes dernières routines. J'ai l'impression que celles de tes posts #18 & #20 sont peut-être plus polyvalentes dans des cas de figures un peu tordus comme celui de la PJ.

Buenas noches

 

[job75]

Bonjour Magic_Doctor, le forum,

Bien sûr, c'est pour ça que j'ai dit que le post #21 était pour le fun.

Bonne journée.