Sub CreateConges()
Dim Cel As Object
Dim NbLig As Integer, DebLig As Integer, DateDeb, DateFin
Dim MoisDeb As Integer, MoisFin As Integer, TabMois(12)
Dim LigPers As Integer, NomPers As String, NbPers As Integer
'
TabMois(1) = "Janvier": TabMois(2) = "Février": TabMois(3) = "Mars"
TabMois(4) = "Avril": TabMois(5) = "Mai": TabMois(6) = "Juin"
TabMois(7) = "Juillet": TabMois(8) = "Août": TabMois(9) = "Septembre"
TabMois(10) = "Octobre": TabMois(11) = "Novembre": TabMois(12) = "Décembre"
'
Sheets("Vacances").Activate
For NbPers = 4 To 102 Step 7
ActiveSheet.Range("B" & NbPers).Select
DebLig = Selection.Row: NomPers = Selection.Value
For NbLig = 0 To 5
DateDeb = ActiveSheet.Range("D" & DebLig + NbLig).Value
DateFin = ActiveSheet.Range("F" & DebLig + NbLig).Value
' On sort de la boucle si il manque une date de congé
If DateDeb = "" Or DateFin = "" Then Exit For
' Sinon on fait la mise en forme
MoisDeb = Month(DateDeb): MoisFin = Month(DateFin)
Do While MoisDeb <= MoisFin
' Sélectionne le classeur contenant la valeur du mois des congés
Sheets("Plan " & TabMois(MoisDeb)).Activate
' Trouve la ligne de la personne en cours
LigPers = LigFind(ActiveSheet.Name, 4, NomPers)
If LigPers = 0 Then
MsgBox "Erreur de recherche pour le nom : " & NomPers
Exit For
End If
' Vérifie si la date correspond aux congés, si oui inscrit "V"
For Each Cel In ActiveSheet.Range("E19:AF19")
If Cel.Value >= DateDeb And Cel.Value <= DateFin Then
Application.EnableEvents = False
If Weekday(Cel.Value, vbMonday) > 5 Then
ActiveSheet.Cells(LigPers, Cel.Column).Value = "X"
Else
ActiveSheet.Cells(LigPers, Cel.Column).Value = "V"
End If
Application.EnableEvents = True
End If
Next
MoisDeb = MoisDeb + 1
Loop
Sheets("Vacances").Activate
Next NbLig
Next NbPers
End Sub
Function LigFind(Feuil As String, NumCol As Integer, Quoi)
On Error Resume Next
With Sheets(Feuil).Columns(NumCol)
' On recherche une valeur
LigFind = .Find(What:=Quoi, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Row
End With
On Error GoTo 0
End Function