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
| Option Explicit
Sub QuiEstDispo()
Dim ValeurRecherche, RangePlage
Dim Jour As String, Debut As String, Fin As String
Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
Dim NomdeProf As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set DicoProfs = CreateObject("Scripting.Dictionary")
Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?") 'définit le jour intéressant
Select Case Jour
Case "Lundi": Colonne = 3
Case "Mardi": Colonne = 4
Case "Mercredi": Colonne = 5
Case "Jeudi": Colonne = 6
Case "Vendredi": Colonne = 7
Case "Samedi": Colonne = 8
Case Else
MsgBox "Veuillez indiquer un jour de la semaine correct!"
Exit Sub
End Select
Debut = InputBox("De quelle heure? - Format : XX:XX:XX ") 'définit le début de la plage horaire
Select Case Debut
Case "08:00:00": RangeeD = 4
Case "08:30:00": RangeeD = 5
Case "09:00:00": RangeeD = 6
Case "09:30:00": RangeeD = 7
Case "10:00:00": RangeeD = 8
Case "10:30:00": RangeeD = 9
Case "11:00:00": RangeeD = 10
Case "11:30:00": RangeeD = 11
Case "12:00:00": RangeeD = 12
Case "12:30:00": RangeeD = 13
Case "13:00:00": RangeeD = 14
Case "13:30:00": RangeeD = 15
Case "14:00:00": RangeeD = 16
Case "14:30:00": RangeeD = 17
Case "15:00:00": RangeeD = 18
Case "15:30:00": RangeeD = 19
Case "16:00:00": RangeeD = 20
Case "16:30:00": RangeeD = 21
Case "17:00:00": RangeeD = 22
Case "17:30:00": RangeeD = 23
Case "18:00:00": RangeeD = 24
Case Else
MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
Exit Sub
End Select
Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX:XX ") 'définit la fin de la plage horaire
Select Case Fin
Case "08:00:00": RangeeF = 4
Case "08:30:00": RangeeF = 5
Case "09:00:00": RangeeF = 6
Case "09:30:00": RangeeF = 7
Case "10:00:00": RangeeF = 8
Case "10:30:00": RangeeF = 9
Case "11:00:00": RangeeF = 10
Case "11:30:00": RangeeF = 11
Case "12:00:00": RangeeF = 12
Case "12:30:00": RangeeF = 13
Case "13:00:00": RangeeF = 14
Case "13:30:00": RangeeF = 15
Case "14:00:00": RangeeF = 16
Case "14:30:00": RangeeF = 17
Case "15:00:00": RangeeF = 18
Case "15:30:00": RangeeF = 19
Case "16:00:00": RangeeF = 20
Case "16:30:00": RangeeF = 21
Case "17:00:00": RangeeF = 22
Case "17:30:00": RangeeF = 23
Case "18:00:00": RangeeF = 24
Case Else
MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
Exit Sub
End Select
RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address 'est censée représenter la plage horaire du jour défini pour l'analyse ci-dessous
' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:
' - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient
' - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.
' - en ignorant les cases qui sont déjà pleines, car s'ils ont déjà un cours, ils ne sont pas dispos pour un nouveau cours!
' - si les critères ci-dessus sont respectés, alors la macro enregistre le nom du prof, en E1 sur chaque onglet de prof, et me l'enregistre dans DicoProfs
'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus
For Each ValeurRecherche In Range(RangePlage)
If Not DicoProfs.Exists(Cells(1, 5).Value) And
With ValeurRecherche
.Value = ""
.Selection.Interior.Pattern = xlNone
End With
Then DicoProfs.Add Cells(1, 5).Value, Cells(1, 5).Value
End If
Next ValeurRecherche
MsgBox (Application.Transpose(DicoProfs.Items))
End Sub |
Partager