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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
| Private Sub CommandButton1_Click()
Dim OE As Worksheet 'déclare la variable OE (Onglet Existant)
Dim NomSalle As String
Dim hde As String
Dim ha As String
Dim valhde As String
Dim valha As String
Dim lassociation As String
Dim lejour As String
Dim lheurede As String
Dim lheurea As String
Dim lignede As Variant
Dim plageSel As Range
Dim col As Integer
Dim L As Integer
NomSalle = ComboBox2.Value
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OE = Worksheets(NomSalle) 'définit l'onglet OE (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Worksheets("Modele").Copy after:=Worksheets("Modele") 'copie l'onglet Modèle après ljui-même
ActiveSheet.Name = NomSalle 'renome l'onglet actif
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
lassociation = ComboBox1.Value
lejour = ComboBox3.Value
lheurede = ComboBox4.Value
lheurea = ComboBox5.Value
Call TraitementAssoc
With Worksheets("Recap")
L = .Range("a65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
.Range("A" & L).Value = NomSalle
.Range("B" & L).Value = lassociation
.Range("C" & L).Value = lejour
.Range("D" & L).Value = lheurede
.Range("E" & L).Value = lheurea
End With
Sheets("Recap").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ligne = ActiveCell.Row
ActiveCell.Value = NomSalle
ligne = ActiveCell.Row
Cells(ligne, 2).Select
ActiveCell.Value = lassociation
Cells(ligne, 3).Select
ActiveCell.Value = lejour
Cells(ligne, 4).Select
ActiveCell.Value = lheurede
hde = ActiveCell.Value
Cells(ligne, 5).Select
ActiveCell.Value = lheurea
ha = ActiveCell.Value
Sheets(NomSalle).Select
Worksheets(NomSalle).Select
'Détermination de la ligne de et de la ligne à pour le planing
lig = 4
col = 1
Cells(lig, col).Select
Do While ActiveCell.Value <> ""
valhde = ActiveCell.Value
If valhde = hde Then
lignede = ActiveCell.Row
Exit Do
End If
lig = lig + 1
Cells(lig, col).Select
Loop
lig = 4
col = 2
Cells(lig, col).Select
Do While ActiveCell.Value <> ""
valha = ActiveCell.Value
If valha = ha Then
lignea = ActiveCell.Row
Exit Do
End If
lig = lig + 1
Cells(lig, col).Select
Loop
'Recherche dans planing si la plage a affecter est deja prise
vide = 0
lde = lignede
la = lignea
Select Case lejour
Case "Lundi"
For I = lde To la
Cells(I, 3).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 3), Cells(lignea, 3)).Select
Case "Mardi"
For I = lde To la
Cells(I, 4).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 4), Cells(lignea, 4)).Select
Case "Mercredi"
For I = lde To la
Cells(I, 5).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 5), Cells(lignea, 5)).Select
Case "Jeudi"
For I = lde To la
Cells(I, 6).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 6), Cells(lignea, 6)).Select
Case "Vendredi"
For I = lde To la
Cells(I, 7).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 7), Cells(lignea, 7)).Select
Case "Samedi"
For I = lde To la
Cells(I, 8).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 8), Cells(lignea, 8)).Select
Case "Dimanche"
For I = lde To la
Cells(I, 9).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 9), Cells(lignea, 9)).Select
End Select
If vide = 1 Then
MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
Worksheets("Recap").Select
Range("A1").End(xlDown).Offset(0, 0).Select
Selection.EntireRow.Delete
Worksheets(NomSalle).Select
Exit Sub
End If
'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
ActiveCell.FormulaR1C1 = lassociation
End Sub |
Probleme de code
Répondre avec citation
Partager