Réalisation d'un planning d'occupation

f NumeroJour = 6

Sub test()
Dim NumeroJour As Integer
Dim maDate As Variant
Dim Feries(), i As Byte, FlagFerie As Boolean

FlagFerie = False

maDate = CDate("13/07/2013")

NumeroJour = Weekday(maDate, vbMonday)

If NumeroJour = 6 Then maDate = maDate + 2
If NumeroJour = 7 Then maDate = maDate + 1

Feries = ListeJoursFeries(Year(maDate))

For i = 1 To 13
    If maDate = Feries(i, 1) Then FlagFerie = True: Exit For
Next i
If FlagFerie = True Then MsgBox "Attention jour férié : "  & Feries(i, 1)
End Sub

Function ListeJoursFeries(An As Integer) As Variant
'myDearFriend! - www.mdf-xlpages.com
'(Tableau des jours fériés français pour l'année An)

Dim D As Date
Dim L As Byte
    D = DimPaques(An)
    For L = 1 To 13
        DF(L, 1) = Choose(L, _
            DateSerial(An, 1, 1), D, D + 1, DateSerial(An, 5, 1), _
            DateSerial(An, 5, 8), D + 39, D + 49, D + 50, DateSerial(An, 7, 14), _
            DateSerial(An, 8, 15), DateSerial(An, 11, 1), DateSerial(An, 11, 11), _
            DateSerial(An, 12, 25))
        DF(L, 2) = Choose(L, _
            "Jour de l'An", "Dimanche de Pâques", "Lundi de Pâques", _
            "Fête du Travail", "Armistice 1945", "Jeudi Ascension", _
            "Dimanche de Pentecôte", "Lundi de Pentecôte", "Fête Nationale", _
            "Assomption", "Toussaint", "Armistice 1918", _
            "Noël")
    Next L
    ListeJoursFeries = DF
End Function

Private Function DimPaques(ByVal An As Integer) As Date
'myDearFriend! - www.mdf-xlpages.com
'(Calcul du dimanche de Pâques d'après un algorithme de Thomas O'Beirne)
Dim n As Integer, c As Integer, a As Byte, b As Byte
    n = An - 1900
    a = n Mod 19
    b = (11 * a + 4 - ((a * 7 + 1) \ 19)) Mod 29
    c = 25 - b - ((n - b + 31 + (n \ 4)) Mod 7)
    DimPaques = DateAdd("d", c, DateSerial(An, 3, 31))
End Function

Private Sub Workbook_Open()
Dim a As Integer ' variable pour commande'
Dim b As Integer
Dim rep As Integer
Dim msg As String ' pour commande grosse pièce'
Dim msg0 As String 'pour stock'
Dim msg1 As String
Dim msg2 As String
Dim msg3 As String
Dim msgt As String
Dim rngTrouve As Range

For a = 2 To 20

If Worksheets("Commandes").Range("G" & a) <> "" And Worksheets("Commandes").Range("F" & a) < Worksheets("Préventif").Range("B1") Then
    msg = Worksheets("Commandes").Range("A" & a) ' pour la pièce'
    msg1 = Worksheets("Commandes").Range("E" & a) ' pour la société'
    With Sheets("Contacts")
        Set rngTrouve = .Columns(1).Cells.Find(msg, Lookat:=xlWhole)
        If Not rngTrouve Is Nothing Then
            msg2 = rngTrouve.Offset(0, 4)
            msg3 = rngTrouve.Offset(0, 5)
        End If
        'msg2 = Application.VLookup(msg, Sheets("Contacts").Range("A2:G36"), 5, True) ' pour l'adresse'
        'msg3 = Application.VLookup(msg, Sheets("Contacts").Range("A2:G36"), 6, True) ' pour le tel'
    End With
    msgt = msg & " à commander chez " & msg1 & Chr(10) & Chr(10) & " Coordonnées : " & Chr(10) & Chr(10) & msg2 & Chr(10) & msg3 & Chr(10) & Chr(10) & "Repousser l'alerte ?"

maDate = CDate(Worksheets("Préventif").Range("G" & i))
NumeroJour = Weekday(maDate, vbMonday)
If NumeroJour = 6 Then Worksheets("Préventif").Range("G" & i) = Worksheets("Préventif").Range("G" & i) + 2
If NumeroJour = 7 Then Worksheets("Préventif").Range("G" & i) = Worksheets("Préventif").Range("G" & i) + 1