Planning d'équipe

[JBARBE]

Bonjour à tous,

Je sèche sur la macro suivante pour un attribuer le même coloriage pour les Fériés concernés que pour les Week-end en ce qui concerne le planning d'une équipe !!

Sub Trace_Dessin()
Application.ScreenUpdating = False
Worksheets("Données").Select: DebutPlage = [C1]: FinPlage = [E1]
'-- effacement des zones de dessin
Worksheets("Dessin").Select: Range("B4:BQ7").Clear: Range("A3").Select
Worksheets("Données").Select: Range("B4").Select

Nb_Personnes = 4
For Personne = 1 To Nb_Personnes

  Worksheets("Données").Select
  Debut = ActiveCell.Offset(Personne, 0)
  Fin = ActiveCell.Offset(Personne, 1)
  Worksheets("Dessin").Select
  
  For Jour = Debut To Fin
    JourSem = Application.WorksheetFunction.Weekday(Jour)
    If JourSem = 1 Or JourSem = 7 Then
       '-- C'est un samedi ou un dimanche
       ActiveCell.Offset(Personne, Jour - DebutPlage + 1).Interior.ColorIndex = 10
     Else
       '-- On attrbibue une couleur différente à chaque personne
       ActiveCell.Offset(Personne, Jour - DebutPlage + 1).Interior.ColorIndex = 3 + Personne
    End If
  Next Jour
Next Personne
Application.ScreenUpdating = True
End Sub


Merci à l'avance !

 

[Modeste]

Re : Planning d'équipe

Bonjour JBARBE,

Peut-être en modifiant ton test comme suit:

If JourSem = 1 Or JourSem = 7 Or Application.CountIf([Feries], Jour) Then

... à tester ...

 

[JBARBE]

Re : Planning d'équipe

C'est parfaitement cela Modeste !!!

Merci beaucoup !!