Réservation salle

Sub WeekEnd()
Dim Cellule As Range, Premier As Boolean, I As Integer
Premier = True
Application.DisplayAlerts = False
For Each Cellule In Selection
If Premier = True Then
If Weekday(Cellule) = 1 Or Weekday(Cellule) = 7 Then
Range(Cells(Cellule.Row, 1), Cells(Cellule.Row + 1, 1)).Interior.ColorIndex = 15
For I = 2 To [COLOR=red][B]7 [COLOR=seagreen]' nombre de salles +1[/COLOR][/B][/COLOR]
Range(Cells(Cellule.Row, I), Cells(Cellule.Row + 1, I)).Interior.ColorIndex = 15
Range(Cells(Cellule.Row, I), Cells(Cellule.Row + 1, I)).Merge
Next I
End If
Premier = False
Else
Premier = True
End If
Next
Application.DisplayAlerts = True
End Sub

Sub Fériés()
Dim Cellule As Range, Premier As Boolean, I As Integer, Jours, Férié As Boolean
Premier = True
Application.DisplayAlerts = False
On Error Resume Next
For Each Cellule In Selection
If Premier = True Then
Jours = JoursFériés("2010")
Férié = False
For I = 0 To UBound(Jours)
If Cellule = Jours(I) Then Férié = True
Next I
If Férié = True Then
Range(Cells(Cellule.Row, 1), Cells(Cellule.Row + 1, 1)).Interior.ColorIndex = 3
For I = 2 To [B][COLOR=#ff0000]7 [/COLOR][COLOR=seagreen]' nombre de salles +1[/COLOR][/B]
Range(Cells(Cellule.Row, I), Cells(Cellule.Row + 1, I)).Interior.ColorIndex = 3
Range(Cells(Cellule.Row, I), Cells(Cellule.Row + 1, I)).Merge
Next I
End If
Premier = False
Else
Premier = True
End If
Next
On Error GoTo 0
Application.DisplayAlerts = True
End Sub

  Arr(11) = LPaques - 3 - Ajust
  Arr(12) = DateSerial(An, 12, 26) - Ajust

Function JoursFériés(An)
' Détermination perpétuelle des jours fériés par année - Résultats sous forme de tableau
' Frédéric Sigoneau
Dim NbOr, Epacte, Ajust As Integer
Dim PLune, LPaques, Arr([COLOR=red][B]12[/B][/COLOR]) As Long
If ActiveWorkbook.Date1904 Then Ajust = 1462
  'calcul du Lundi de Pâques
  NbOr = (An Mod 19) + 1
  Epacte = (11 * NbOr - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
  PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
  If Epacte = 24 Then PLune = PLune - 1
  If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
  LPaques = PLune - Weekday(PLune) + vbMonday + 7        'Lundi Pâques
 
  'tableau des fériés
  Arr(0) = DateSerial(An, 1, 1) - Ajust
  Arr(1) = LPaques - Ajust
  Arr(2) = LPaques + 38 - Ajust  'Ascension
  Arr(3) = LPaques + 49 - Ajust  'Pentecôte
  Arr(4) = DateSerial(An, 5, 1) - Ajust
  Arr(5) = DateSerial(An, 5, 8) - Ajust
  Arr(6) = DateSerial(An, 7, 14) - Ajust
  Arr(7) = DateSerial(An, 8, 15) - Ajust
  Arr(8) = DateSerial(An, 11, 1) - Ajust
  Arr(9) = DateSerial(An, 11, 11) - Ajust
  Arr(10) = DateSerial(An, 12, 25) - Ajust
[COLOR=red][B] Arr(11) = LPaques - 3 - Ajust[/B][/COLOR]
[B][COLOR=red] Arr(12) = DateSerial(An, 12, 26) - Ajust[/COLOR][/B]
  'tri du tableau
  Dim I%, J%, K%, tmp
  For I = LBound(Arr) To UBound(Arr)
    J = I
    For K = J + 1 To UBound(Arr)
      If Arr(K) <= Arr(J) Then J = K
    Next K
    If I <> J Then
      tmp = Arr(J): Arr(J) = Arr(I): Arr(I) = tmp
    End If
  Next I
 
  'renvoi du résultat
  On Error GoTo Fin
  If Application.Caller.Rows.Count > 1 Then
    JoursFériés = Application.Transpose(Arr)
    Exit Function
  End If
Fin:
  JoursFériés = Arr
End Function 'fs