1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
| Sub GenererProgrammePremierJourDeReserve()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Rotation") ' Assurez-vous que le nom de la feuille est correct
' Trouver la dernière ligne du tableau "Programme Journalier Préposés-Chauffeurs"
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Ajouter le titre "Programme Du Premier Jour De Réserve" sous le tableau existant
Dim newTitleRow As Long
newTitleRow = lastRow + 2
ws.Cells(newTitleRow, 1).Value = "Programme Du Premier Jour De Réserve"
ws.Cells(newTitleRow, 1).Font.Color = RGB(0, 128, 0) ' Titre en vert
ws.Cells(newTitleRow, 1).Font.Bold = True
' Obtenir le jour de la semaine pour lequel on crée le programme
Dim jourSemaine As String
jourSemaine = InputBox("Entrez le jour du programme (dimanche, lundi, etc.)")
' Créer un nouveau tableau à partir des remplacements
Dim i As Long
Dim destination As String
Dim reservePrepose As String
Dim reserveChauffeur As String
Dim newRow As Long
newRow = newTitleRow + 1 ' Commencer à remplir le tableau sous le titre
' Parcourir le tableau "Programme Journalier Préposés-Chauffeurs"
For i = 2 To lastRow ' En partant de la ligne 2 pour éviter les titres
destination = ws.Cells(i, 3).Value ' Destination de la ligne actuelle
' Copie de la ligne vers le nouveau tableau
ws.Cells(newRow, 1).Value = ws.Cells(i, 1).Value ' Préposé
ws.Cells(newRow, 2).Value = ws.Cells(i, 2).Value ' Chauffeur
ws.Cells(newRow, 3).Value = destination ' Destination
ws.Cells(newRow, 4).Value = ws.Cells(i, 4).Value ' Statut Préposé
ws.Cells(newRow, 5).Value = ws.Cells(i, 5).Value ' Statut Chauffeur
' Vérifier l'absence du préposé
If IsAbsent(ws.Cells(i, 4).Value) Then
' Trouver un préposé de réserve
reservePrepose = TrouverRemplacement("Préposé", ws, destination, jourSemaine)
If reservePrepose <> "" Then
ws.Cells(newRow, 1).Value = reservePrepose ' Remplacement du préposé
Else
MsgBox "Aucun préposé de réserve disponible pour " & destination, vbExclamation
End If
End If
' Vérifier l'absence du chauffeur
If IsAbsent(ws.Cells(i, 5).Value) Then
' Trouver un chauffeur de réserve
reserveChauffeur = TrouverRemplacement("Chauffeur", ws, destination, jourSemaine)
If reserveChauffeur <> "" Then
ws.Cells(newRow, 2).Value = reserveChauffeur ' Remplacement du chauffeur
Else
MsgBox "Aucun chauffeur de réserve disponible pour " & destination, vbExclamation
End If
End If
newRow = newRow + 1 ' Passer à la ligne suivante dans le nouveau tableau
Next i
End Sub
Function IsAbsent(status As String) As Boolean
' Vérifier si un préposé ou chauffeur est absent
Select Case status
Case "CA", "AA", "CM", "CEXP", "MAP", "DT", "ST4", "RGI", "CSS"
IsAbsent = True
Case Else
IsAbsent = False
End Select
End Function
Function TrouverRemplacement(typeRemplacement As String, ws As Worksheet, destination As String, jourSemaine As String) As String
Dim reserves As Range
Dim etats As Range
Dim i As Long
' Définir les plages en fonction du type (Préposé ou Chauffeur)
If typeRemplacement = "Préposé" Then
Set reserves = ws.Range("I2:I20") ' Colonne des préposés de réserve
Set etats = ws.Range("K2:K20") ' Colonne de l'état des préposés de réserve
Else
Set reserves = ws.Range("J2:J20") ' Colonne des chauffeurs de réserve
Set etats = ws.Range("L2:L20") ' Colonne de l'état des chauffeurs de réserve
End If
' Parcourir les réserves pour trouver un remplacement disponible
For i = 1 To reserves.Rows.Count
If etats.Cells(i, 1).Value = "" Then ' Disponible
Select Case reserves.Cells(i, 1).Value
' Vérifier les interdictions en fonction du jour et de la destination
Case "Reserve1"
If (jourSemaine = "mardi" Or jourSemaine = "jeudi") And destination = "Tebessa" Then GoTo NextReserve
If (jourSemaine = "lundi" Or jourSemaine = "jeudi") And destination = "Constantine1" Then GoTo NextReserve
Case "Reserve2"
If destination = "Annaba1" Or ((jourSemaine = "mardi" Or jourSemaine = "jeudi") And destination = "Khenchela") Then GoTo NextReserve
Case "Reserve3"
If destination = "Setif1" Or ((jourSemaine = "dimanche" Or jourSemaine = "mardi") And destination = "Batna2") Then GoTo NextReserve
Case "Reserve4"
If destination = "Guelma" Or destination = "Biskra" Then GoTo NextReserve
Case "Reserve5"
If destination = "OEB" Or destination = "BBA" Then GoTo NextReserve
Case "Reserve6"
If ((jourSemaine = "dimanche" Or jourSemaine = "mardi") And destination = "Souk Ahras") Or destination = "Setif2" Then GoTo NextReserve
Case "Reserve7"
If destination = "Setif3" Or destination = "Skikda1" Then GoTo NextReserve
Case "Reserve8"
If destination = "Annaba2" Or destination = "Batna1" Then GoTo NextReserve
End Select
' Si pas d'interdiction, retourner cette réserve
TrouverRemplacement = reserves.Cells(i, 1).Value
etats.Cells(i, 1).Value = "Utilisé" ' Marquer comme utilisé
Exit Function
End If
NextReserve:
Next i
' Si aucune réserve n'est disponible
TrouverRemplacement = ""
End Function |
macro vba pour générer une rotation en remplacant les absents par les réserves
Répondre avec citation
Partager