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 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
| 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
Dim dicoprofs As Object
Dim curSheet As Worksheet
Dim curligne As Integer
Dim result() As String
Dim BreakBoucle As Boolean
Dim I As Integer
Dim reponse As String
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", "lundi": Colonne = 3
Case "Mardi", "mardi": Colonne = 4
Case "Mercredi", "mercredi": Colonne = 5
Case "Jeudi", "jeudi": Colonne = 6
Case "Vendredi", "vendredi": Colonne = 7
Case "Samedi", "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 ") 'définit le début de la plage horaire
Select Case Debut
Case "08:00": RangeeD = 4
Case "08:30": RangeeD = 5
Case "09:00": RangeeD = 6
Case "09:30": RangeeD = 7
Case "10:00": RangeeD = 8
Case "10:30": RangeeD = 9
Case "11:00": RangeeD = 10
Case "11:30": RangeeD = 11
Case "12:00": RangeeD = 12
Case "12:30": RangeeD = 13
Case "13:00": RangeeD = 14
Case "13:30": RangeeD = 15
Case "14:00": RangeeD = 16
Case "14:30": RangeeD = 17
Case "15:00": RangeeD = 18
Case "15:30": RangeeD = 19
Case "16:00": RangeeD = 20
Case "16:30": RangeeD = 21
Case "17:00": RangeeD = 22
Case "17:30": RangeeD = 23
Case "18: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 ") 'définit la fin de la plage horaire
Select Case Fin
Case "08:00": RangeeF = 4
Case "08:30": RangeeF = 5
Case "09:00": RangeeF = 6
Case "09:30": RangeeF = 7
Case "10:00": RangeeF = 8
Case "10:30": RangeeF = 9
Case "11:00": RangeeF = 10
Case "11:30": RangeeF = 11
Case "12:00": RangeeF = 12
Case "12:30": RangeeF = 13
Case "13:00": RangeeF = 14
Case "13:30": RangeeF = 15
Case "14:00": RangeeF = 16
Case "14:30": RangeeF = 17
Case "15:00": RangeeF = 18
Case "15:30": RangeeF = 19
Case "16:00": RangeeF = 20
Case "16:30": RangeeF = 21
Case "17:00": RangeeF = 22
Case "17:30": RangeeF = 23
Case "18: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
ReDim result(0)
result(0) = ""
For Each curSheet In Sheets
If curSheet.Name <> "Administratif" And curSheet.Name <> "Cours" Then
curSheet.Activate
BreakBoucle = False
For curligne = RangeeD To RangeeF
If GetValue(translateCoord(curligne, Colonne)) = "" Then
If Selection.Interior.Pattern <> xlNone Then
BreakBoucle = True
Exit For
End If
Else
BreakBoucle = True
Exit For
End If
Next curligne
If Not BreakBoucle Then
result(UBound(result)) = GetValue(translateCoord(1, 5))
ReDim Preserve result(UBound(result) + 1)
End If
End If
Next
If UBound(result) > 0 Then ReDim Preserve result(UBound(result) - 1)
Sheets("Cours").Activate
If result(0) <> "" Then
reponse = "liste des personnes dispo:"
For I = 0 To UBound(result)
reponse = reponse + vbCrLf + result(I)
Next I
MsgBox (reponse)
Else
MsgBox "personne de dispo"
End If
End Sub
Private Function translateCoord(NumLine As Integer, NumCol As Integer) As String
translateCoord = TranslateNumColIntoChar(NumCol) & Trim(Str(NumLine))
End Function
Private Function TranslateNumColIntoChar(NumCol As Integer) As String
Dim Reste As Long
If NumCol <= 26 Then
TranslateNumColIntoChar = Chr(Asc("A") + NumCol - 1)
Else
Reste = (NumCol - 1) Mod 26
TranslateNumColIntoChar = Chr(Asc("A") + Int((NumCol - 1) / 26) - 1) & Chr(Asc("A") + Reste)
End If
End Function
Private Function GetValue(cellule As String) As Variant
Range(cellule).Select
GetValue = ActiveCell.Value
End Function |
Partager