Clignotement cellule suivant couleur

[Fratrix]

Salut!
Je vous rassure de suite, j'ai utilisé la fonction recherche le plus possible mais je n'ai pas trouvé le rensignement qui va bien.
Donc je vous explique mon probleme.
Je souhaiterais trouver une macro (ou une mfc?) qui fait clignoter la 7eme cellule suivant la couleur des 6 précédentes cellules (en ligne)
Ex, Si les 6 cellules sont vertes, alors la 7eme clignote
Mais si une de ces cellules est blanche, alors le compte repart de celle-ci.
J'espere etre clair

En gros, J'essaye de creer un tableau pour gerer le planning du personnel, par jour et par affectation (atelier ou bord ou repos).
Un exemple:
Colonne A: Les noms (exemple: A1= nom1, A2=nom2, etc..)
Colonne B: Jour
Colonne C: Jour +1
Colonne C: Jour +2
Etc...
Aprés j'utilise des MFC: si atelier alors couleur A, si bord alors couleur A , si repos alors couleur blanche.
Pour nom1:
B1= verte
C1= verte
etc...
La 7eme cellule représente le repos obligatoire hebdomadaire dû au code du travail.
Cette macro me permettrai de gérer plus facilement le personnel qui doit etre au repos.
J'ai bien récuperé un code sur le forum mais il s'applique que pour une valeur dans une cellule de référence...
Je mets un exemple en piece jointe.
Bon j'espere avoir été clair et merci de votre aide!

 

[PMO2]

Re : Clignotement cellule suivant couleur

Bonjour,

Une piste en VBA

1) Copiez le code ci-dessous dans un module standard

'### Constante à adapter ###
Public Const CHAINE_SANS_ACTION As String = "repos"
Private Const MUSIQUE As Boolean = True 'False pour enlever la musique
Private Const DELAI As Long = 90        'Délai de chaque note de musique
'###########################

Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function Beep& Lib "Kernel32" (ByVal Fq&, ByVal Tm&)

Public BoolStop As Boolean
Public R As Range

Sub Timer(Cellule As Range)
Set R = Cellule
Application.OnTime Now, "Clignote"
End Sub

Sub Clignote(Optional dummy As Byte)
Dim notes As Variant
Dim OldColor&
Dim OldSize&
Dim i&
notes = Array(500, DELAI, 500, DELAI, 500, DELAI, 550, DELAI, 625, 2 * DELAI, 550, 2 * DELAI, _
              500, DELAI, 625, DELAI, 550, DELAI, 550, DELAI, 500, 3 * DELAI)
BoolStop = True
With R.Font
  OldColor& = .ColorIndex
  OldSize& = .Size
  .Size = 20
End With
If MUSIQUE Then
  For i& = LBound(notes) To UBound(notes) Step 2
    Beep notes(i&), notes(i& + 1)
  Next i&
End If
Do Until Not BoolStop
  i& = i& + 1
  If i& Mod 57 = 0 Then i& = 1
  Sleep 25
  DoEvents
  R.Font.ColorIndex = i&
Loop
With R.Font
  .ColorIndex = OldColor&
  .Size = OldSize&
End With
End Sub

2) Copiez le code ci-dessous dans la fenêtre de code de la feuille "planning"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col&
Dim lig&
Dim j&
Dim R As Range
Dim var
Dim bool
col& = Target.Column
If col& < 11 Then Exit Sub
lig& = Target.Row
Set R = Range(Cells(lig&, col& - 6), Cells(lig&, col&))
var = R
For j& = 1 To 7
  If var(1, j&) = "" Or var(1, j&) = CHAINE_SANS_ACTION Then Exit Sub
Next j&
Set R = Target
Target.Offset(1, 0).Select
Call Timer(R)
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If BoolStop Then
  BoolStop = False
  Application.EnableEvents = False
  If Not R Is Nothing Then R = ""
  Application.EnableEvents = True
End If
End Sub

Adaptez éventuellement, à votre usage, les constantes cernées par des ###.

Cordialement.

PMO
Patrick Morange