Excel VBA - Données, Dico, et MsgBox

**Guillaume83** · 17/05/2011, 13h01

Bonjour à tous,

Je suis actuellement en train de travailler sur la construction d’un emploi du temps intelligent et multifonctionnel. En tant qu’étudiant, j’en profite du coup pour me former au VBA sur Excel.

Afin de mieux comprendre la situation, je vais décrire mon fichier. J’ai deux premiers onglets administratifs, qui comportent des paramètres bateaux pour excel, dont un tableauA, dont chaque ligne comprend le nom d’un prof, une heure de debut, de fin, et un cours. Ces informations sont ensuite répercutées dans l’onglet qui lui est destiné sous une autre forme. Ce tableauA est appelé à compter plusieurs lignes, et ce qui m’intéresse désormais maintenant, c’est de créer une macro qui me permettraient de connaître quel prof serait dispos avec les critères établis. Je vous laisse lire le code ci-dessous.

Mais mon code ne marche pas, et je désespère un peu là…

Je me suis permis de publier ce post sur plusieurs forums. Ne vous en sentez pas offusqués, c’est juste pour pouvoir étudier les différents réponses qui me seraient proposées.

Cordialement,

Guillaume

Fichier Sans Macro : http://www.cijoint.fr/cjlink.php?fil...ijPgt9PDG.xlsx
Fichier XL2007 avec Macro : http://www.cijoint.fr/cjlink.php?fil...ijkTrTRU1.xlsm
Fichier XL 97-2003 : http://www.cijoint.fr/cjlink.php?fil...cijU6pNyng.xls

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Guillaume83** · 17/05/2011, 15h01

Les gars, je vous remercie de votre temps... On vient de me filer ça sur un autre forum, je le partage avec vous!

BOnne analyse!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Excel VBA - Données, Dico, et MsgBox [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager