Amelioration d"un fichier excel de réservation de salle

**ron74** · 31/10/2020, 14h36

Bonjour à tous

Je voudrais savoir si il y a moyen d'améliorer le fichier joint

Je trouve que la MAJ de ce fichier est un peu lente quand on change de mois

C'est un fichier pour suivre la réservation de 3 salles avec un choix d'heure de réservation

Merci de vos remarques

**mfoxy** · 31/10/2020, 14h58

Bonjour,

Très peu de membre ouvrent les pièces jointes pour des raisons évidentes de sécurité.

Pourriez-vous déposer votre code, et capture d,écran de vos tables de manière à mieux vous aider.

Une explication, exhaustive,et en bon français (sans jargon) excel/vba du traitement à effectuer ainsi que du rendu voulu.

Bav,

**ron74** · 31/10/2020, 15h22

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
Public Cout_Cuisine, Cout_demi, Cout_demiApres, Cout_Salle, Modif, Ligne_ecriture_modification
Public Valeur(21), Couleur, Nbr_jour_1, Heure_reser(3)
Public Date_deb_anc_reser, Date_fin_anc_reser, Salle_anc_reser
 
Public Sub Dessin_reservation()
Ligne_tableau = 3
        Application.ScreenUpdating = False
        Init_plage
        date_debut_planning = Range("A3").Value
        date_fin_planning = Range("A3").End(xlDown).Value
        For cpt = 2 To Worksheets("reservations").Range("A1").End(xlDown).Row
                If DateValue(Worksheets("reservations").Cells(cpt, 12).Value) >= DateValue(date_debut_planning) And DateValue(Worksheets("reservations").Cells(cpt, 12).Value) <= DateValue(date_fin_planning) Then
                        date_debut_reservation = DateValue(Worksheets("reservations").Cells(cpt, 12).Value)
                        date_fin_reservation = DateValue(Worksheets("reservations").Cells(cpt, 13).Value)
                        nombre_jours = date_fin_reservation - date_debut_reservation
                        Numero = Worksheets("reservations").Cells(cpt, 1).Value
                        civilite = Worksheets("reservations").Cells(cpt, 3).Value
                        Nom = Worksheets("reservations").Cells(cpt, 4).Value
                        Prenom = Worksheets("reservations").Cells(cpt, 5).Value
                        telephone = Worksheets("reservations").Cells(cpt, 9).Value
                        mail = Worksheets("reservations").Cells(cpt, 10).Value
                        salle = Worksheets("reservations").Cells(cpt, 11).Value
                         Cuisine = IIf(Worksheets("reservations").Cells(cpt, 14).Value = "Vrai", "Oui", "")
                         DemiAvant = IIf(Worksheets("reservations").Cells(cpt, 15).Value = "Vrai", "Oui", "")
                       cout = Worksheets("reservations").Cells(cpt, 17).Value
                         DemiApres = IIf(Worksheets("reservations").Cells(cpt, 18).Value = "Vrai", "Oui", "")
                         Infos = Worksheets("reservations").Cells(cpt, 19).Value
                         HeureReservation = Worksheets("reservations").Cells(cpt, 20).Value
                         ColonnePlanning = Worksheets("reservations").Cells(cpt, 21).Value
                       Set Ligne_ecriture = Cells.Find(date_debut_reservation)
                        If Ligne_ecriture Is Nothing Then GoTo 10
                                Ligne_ecriture = Cells.Find(date_debut_reservation).Row
                                If salle = "Grande Salle" Then
                                        Couleur = 13762559
                                ElseIf salle = "Salle 3-5" Then
                                        Couleur = 14277119
                               Else
                                          Couleur = 14348258
                              End If
                        Cells(Ligne_ecriture, ColonnePlanning) = Numero '& "-" & Nom & " - (" & Cout & ") " & Cuisine & Chr(13) & Chr(10) & telephone
                         With Cells(Ligne_ecriture, ColonnePlanning)
                                .AddComment
                                .Comment.Visible = False
                                .Comment.Text Text:= _
                                "Réservation n° : " & Numero & Chr(10) & civilite & " " & Nom & " " & Prenom & Chr(10) & "Cout= " & cout & Chr(10) & "Mail : " & mail & Chr(10) & Infos & Chr(10) & "Heure : " & Format(HeureReservation, "hh:mm")
                                .Comment.Shape.TextFrame.AutoSize = True
                                .Comment.Shape.TextFrame.AutoSize = True
                        End With
 
                       If nombre_jours = 0 Then
                                Cells(Ligne_ecriture, ColonnePlanning).Interior.Color = Couleur
                       Else
                                Range(Cells(Ligne_ecriture, ColonnePlanning), Cells(Ligne_ecriture + nombre_jours, ColonnePlanning)).MergeCells = True
                                Range(Cells(Ligne_ecriture, ColonnePlanning), Cells(Ligne_ecriture + nombre_jours, ColonnePlanning)).Interior.Color = Couleur
                        End If
                         With Cells(Ligne_ecriture, ColonnePlanning).Font
                                .Bold = True
                                .ColorIndex = 3
                        End With
                        Range("M" & Ligne_tableau) = Numero
                        Range("M" & Ligne_tableau).Interior.Color = Couleur
                        Range("N" & Ligne_tableau) = Nom & " " & Prenom
                        Range("O" & Ligne_tableau) = telephone
                        Range("P" & Ligne_tableau) = Cuisine
                        Range("R" & Ligne_tableau) = DemiAvant
                        Range("S" & Ligne_tableau) = DemiApres
                        Ligne_tableau = Ligne_tableau + 1
                      End If
 
10        Next
        Application.ScreenUpdating = True
End Sub
Sub Dessins()
        If Valeur(11) = "Grande Salle" Then
                Couleur = 13762559
        ElseIf Valeur(11) = "Salle 3-5" Then
                Couleur = 14277119
        Else
                Couleur = 14348258
        End If
                Col = ActiveCell().Column
 
If Modif = True Then
        Ligne_deb_anc_reser = Range("A3:A33").Find(Date_deb_anc_reser).Row
        Ligne_fin_anc_reser = Range("A3:A33").Find(Date_fin_anc_reser).Row
                With Range(Cells(Ligne_deb_anc_reser, ActiveCell().Column), Cells(Ligne_fin_anc_reser, ActiveCell().Column))
                        .MergeCells = False
                        .ClearContents
                        .Borders().LineStyle = xlContinuous
                        .Interior.Pattern = xlNone
                        .ClearComments
                End With
End If
        LigneDeb = Range("A3:A33").Find(Valeur(12)).Row
        Lignefin = Range("A3:A33").Find(Valeur(13)).Row
 
        With Range(Cells(LigneDeb, Col), Cells(Lignefin, Col))
                .MergeCells = True
                .Interior.Color = Couleur
                .Borders().LineStyle = xlContinuous
                .Font.Bold = True
                .Font.ColorIndex = 3
        End With
        With Cells(LigneDeb, Col)
                .Value = Valeur(1)
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:= _
                "Réservation n° : " & Valeur(1) & Chr(10) & Valeur(3) & " " & Valeur(4) & " " & Valeur(5) & Chr(10) & "Cout= " & Valeur(17) & Chr(10) & "Mail : " & Valeur(10) & Chr(10) & "info : " & Valeur(19) & Chr(10) & "Heure : " & Valeur(20)
                .Comment.Shape.TextFrame.AutoSize = True
        End With
 
        If Modif = True Then
                Set c = Range("M3:M33").Find(Valeur(1))
                Cells(c.Row, 13) = Valeur(1)
                Cells(c.Row, 13).Interior.Color = Couleur
                Cells(c.Row, 14) = Valeur(4)
                Cells(c.Row, 15) = Valeur(9)
                Cells(c.Row, 16) = IIf(Valeur(14), "Oui", "")
                Cells(c.Row, 17) = IIf(Valeur(15), "Oui", "")
                Cells(c.Row, 18) = IIf(Valeur(18), "Oui", "")
        Else
                Ligne_ecriture = Range("M2").End(xlDown).Row + 1
                Cells(Ligne_ecriture, 13) = Valeur(1)
                Cells(Ligne_ecriture, 13).Interior.Color = Couleur
                Cells(Ligne_ecriture, 14) = Valeur(4)
                Cells(Ligne_ecriture, 15) = Valeur(9)
                Cells(Ligne_ecriture, 16) = IIf(Valeur(14), "Oui", "")
                Cells(Ligne_ecriture, 17) = IIf(Valeur(15), "Oui", "")
                Cells(Ligne_ecriture, 18) = IIf(Valeur(18), "Oui", "")
 
        End If
 
End Sub

Nom : feuiile Planning.jpg
Affichages : 718
Taille : 350,8 Ko

Nom : feuille reservation.jpg
Affichages : 226
Taille : 317,7 Ko

Nom : formulaire.jpg
Affichages : 253
Taille : 343,3 Ko

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
Sub Init_Combo(Optional X As Byte)
Dim I As Byte
 
        With Sheets("Planning")
                .ComboBox1.List = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
                For I = 0 To 21
                        .ComboBox2.AddItem 2020 + I
                Next I
        End With
End Sub
 
Sub init_date()
        Range("A3:A33").ClearContents
        Application.ScreenUpdating = False
        Date_selection = DateValue("01/" & Sheets("Planning").ComboBox1.Value & "/" & Sheets("Planning").ComboBox2.Value)
        Mois_selection = Month(Date_selection)
        Annee_selection = Year(Date_selection)
        Range("A1").Value = Mois_selection & " - " & Annee_selection
        Range("A3").FormulaR1C1 = Date_selection
        Range("A3").AutoFill Destination:=Range("A3:A" & Day(Application.WorksheetFunction.EoMonth(Date_selection, 0)) + 2), Type:=xlFillDefault
        Init_plage
        Range("A1").Select
        Application.ScreenUpdating = True
End Sub
 
Sub Init_plage()
        With Range("C3:K33")
                .ClearContents
                .MergeCells = False
                .Borders().LineStyle = xlContinuous
                .Interior.Pattern = xlNone
                .ClearComments
                .Font.Bold = False
                .Font.ColorIndex = xlAutomatic
        End With
        Range("M3:R33").ClearContents
        Range("M3:R33").Interior.Pattern = xlNone
End Sub
Sub Init_Combo_Heure()
Dim Val_resa(3)
Dim Heur_Plan(3)
        regdonnée = Worksheets("Reservations").Range("A1").CurrentRegion
 
        If Reservations.List_Salles = "Grande Salle" Then
                Val_resa(1) = Cells(ActiveCell().Row, 3)
                Val_resa(2) = Cells(ActiveCell().Row, 4)
                Val_resa(3) = Cells(ActiveCell().Row, 5)
        ElseIf Reservations.List_Salles = "Salle 3-5" Then
                Val_resa(1) = Cells(ActiveCell().Row, 6)
                Val_resa(2) = Cells(ActiveCell().Row, 7)
                Val_resa(3) = Cells(ActiveCell().Row, 8)
        Else
                Val_resa(1) = Cells(ActiveCell().Row, 9)
                Val_resa(2) = Cells(ActiveCell().Row, 10)
                Val_resa(3) = Cells(ActiveCell().Row, 11)
        End If
        For cpt = 1 To 3
                If Val_resa(cpt) <> "" Then
                        For I = 2 To UBound(regdonnée)
                                If regdonnée(I, 1) = Val_resa(cpt) Then
                                        Heur_Plan(cpt) = Format(regdonnée(I, 20), "hh:mm")
                                        Exit For
                                End If
                        Next I
                End If
        Next cpt
 
        For cpt = 1 To Worksheets("cfg").Range("E1").End(xlDown).Row
                Reservations.Heure_reservation.AddItem Format(Worksheets("Cfg").Range("E" & cpt), "hh:mm")
        Next cpt
 
        For j = Reservations.Heure_reservation.ListCount - 1 To 0 Step -1
                For cpt = 1 To 3
                        If Reservations.Heure_reservation.List(j, 0) = Heur_Plan(cpt) Then
                                Reservations.Heure_reservation.RemoveItem (j)
                                Exit For
                        End If
                 Next cpt
        Next j
End Sub

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
Public Sub ecrire_reservation()
If Modif = False Then
        Ligne_ecriture = Worksheets("reservations").Range("A1").End(xlDown).Row + 1
Else
        Ligne_ecriture = Ligne_ecriture_modification
End If
        For cpt = 1 To 21
        If cpt = 12 Or cpt = 13 Then
                 Worksheets("reservations").Cells(Ligne_ecriture, cpt) = DateValue(Valeur(cpt))
       ElseIf cpt = 16 Then
                 Worksheets("reservations").Cells(Ligne_ecriture, cpt) = Val(Valeur(cpt))
       Else
                Worksheets("reservations").Cells(Ligne_ecriture, cpt) = Valeur(cpt)
        End If
        Next
Dessins
End Sub
 
 
Public Sub Suppression()
        Set c = Worksheets("Reservations").Range("A1:A" & Worksheets("reservations").Range("A1").End(xlDown).Row).Find(ActiveCell().Value)
        Ligne_Suppression = c.Row
        Worksheets("Reservations").Rows(Ligne_Suppression).Delete
        Dessin_reservation
End Sub

Code VB du formulaire

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
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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
Private Sub Adresse_AfterUpdate()
    Adresse = Me.Adresse.Value
End Sub
 
Private Sub Annuler_Click()
    Unload Me
End Sub
 
Private Sub Civilité_Change()
        If Me.Civilité = "Paroisse" Then Me.Nom = "PAROISSE"
End Sub
 
Private Sub CP_AfterUpdate()
    CP = Me.CP.Value
End Sub
 
Private Sub Cuisine_Change()
    Me.Prix = Format(((DateValue(DTPDateFin) - DateValue(DTPDateDebut)) + 1) * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
End Sub
 
Private Sub Demi_Apres_Click()
    Me.Prix = Format(((DateValue(DTPDateFin) - DateValue(DTPDateDebut)) + 1) * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
End Sub
 
Private Sub DTPDateDebut_AfterUpdate()
If Me.DTPDateFin <> "" Then
DTPDateDebut = DateValue(DTPDateDebut)
If DateValue(Me.DTPDateDebut) > DateValue(DTPDateFin) Then
        MsgBox "La date début doit être inférieure à la date fin"
        Me.DTPDateDebut = ""
        Exit Sub
Else
Me.Nbr_jours = (DateValue(Me.DTPDateFin) - DateValue(Me.DTPDateDebut)) + 1
 
End If
End If
End Sub
 
Private Sub DTPDateFin_AfterUpdate()
If Me.DTPDateDebut <> "" And Me.DTPDateFin <> "" Then
        If DateValue(Me.DTPDateFin) < DateValue(DTPDateDebut) Then
        MsgBox "La date fin doit être supérieure à la date début"
        Me.DTPDateFin = ""
        Exit Sub
Else
Me.Nbr_jours = (DateValue(Me.DTPDateFin) - DateValue(Me.DTPDateDebut)) + 1
    Me.Prix = Format(((DateValue(DTPDateFin) - DateValue(DTPDateDebut)) + 1) * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
End If
End If
End Sub
 
Private Sub EMail_AfterUpdate()
    EMail = Me.EMail.Value
End Sub
 
 
Private Sub Info_AfterUpdate()
    Info = Me.Info.Value
End Sub
 
Private Sub List_Salles_Change()
    Cout_Salle = Me.List_Salles.List(Me.List_Salles.ListIndex, 1)
    Me.Prix = Format(((DateValue(DTPDateFin) - DateValue(DTPDateDebut)) + 1) * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
        If List_Salles = "Grande Salle" Then
                Couleur = 13762559
        ElseIf salle = "Salle 3-5" Then
                Couleur = 14277119
        Else
                Couleur = 14348258
        End If
End Sub
 
 
Private Sub Nom_Change()
    Me.Nom.Value = UCase(Me.Nom.Text)
End Sub
 
Private Sub Nom_AfterUpdate()
    Nom = Me.Nom.Value
End Sub
 
Private Sub Option_demi_Change()
    Me.Prix = Format(((DateValue(DTPDateFin) - DateValue(DTPDateDebut)) + 1) * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
End Sub
 
 
Private Sub Supprimer_Click()
réponse = MsgBox("Vous allez supprimer cette resevation", vbYesNo + vbCritical, "ATTENTION")
If réponse = 6 Then
 
    Suppression
    Unload Me
End If
End Sub
 
Private Sub Téléphone_AfterUpdate()
    Téléphone = Me.Téléphone.Value
End Sub
 
Private Sub Téléphone_Change()
    Select Case Len(Me.Téléphone)
        Case 2, 5, 8, 11: Me.Téléphone.Value = Me.Téléphone.Value & " "
    End Select
    Me.Téléphone = Me.Téléphone
End Sub
 
Private Sub EMail_Change()
    S = Me.EMail.Value
    If InStr(1, S, "@") > 0 And InStr(1, S, ".") > 0 Then
        Me.EMail.ForeColor = RGB(0, 0, 255)
        Me.EMail.Font.Underline = True
    Else
        Me.EMail.ForeColor = &H80000008
        Me.EMail.Font.Underline = False
    End If
 
End Sub
 
Private Sub Prénom_AfterUpdate()
    Prénom = Me.Prénom.Value
End Sub
 
Private Sub Prénom_Change()
        S = Prénom.Text
        Prénom.Text = UCase(Mid(S, 1, 1)) & Mid$(S, 2, Len(S))
        Prénom.SelStart = Len(S)
End Sub
 
Private Sub Ville_Change()
    Me.Ville.Value = UCase(Me.Ville.Text)
End Sub
 
Private Sub Ville_AfterUpdate()
    Ville = Me.Ville.Value
End Sub
 
Private Sub UserForm_Initialize()
    Occupation = False
    If Modif = True Then
        Me.Reser.Caption = "MODIFICATION RESERVATION : "
        Me.Supprimer.Visible = True
    Else
        Me.Reser.Caption = "NOUVELLE RESERVATION : "
        Me.Supprimer.Visible = False
    End If
'    Me.MonthView1.Value = Now()
        Me.Civilité.Clear
        Me.Civilité.AddItem " "
        Me.Civilité.AddItem "Mr"
        Me.Civilité.AddItem "Mme"
        Me.Civilité.AddItem "Paroisse"
        Me.Option_demi.Value = False
        Me.Cuisine.Value = False
        Me.Demi_Apres.Value = False
        Me.Num_reser = Range("reservations!A" & Range("reservations!A1").End(xlDown).Row).Value + 1
        If ActiveCell.Column = 3 Or ActiveCell.Column = 4 Or ActiveCell.Column = 5 Then
                Me.List_Salles.RowSource = "cfg!A2:B2" '& Range("cfg!A1").End(xlDown).Row
        ElseIf ActiveCell.Column = 6 Or ActiveCell.Column = 7 Or ActiveCell.Column = 8 Then
                Me.List_Salles.RowSource = "cfg!A3:B3" '& Range("cfg!A1").End(xlDown).Row
        ElseIf ActiveCell.Column = 9 Or ActiveCell.Column = 10 Or ActiveCell.Column = 11 Then
                Me.List_Salles.RowSource = "cfg!A4:B4" '& Range("cfg!A1").End(xlDown).Row
        End If
        Total = 0
        Cout_Cuisine = Range("Cfg!D2").Value
        Cout_demi = Range("Cfg!C2").Value
        Cout_demiApres = Range("Cfg!C2").Value
        Cout_Salle = 0
End Sub
 
Private Sub Valider_Click()
    If Me.Nom.Value = "" Then
        MsgBox "Vous devez entre un nom", vbCritical + vbOKOnly, "Erreur"
        Exit Sub
    End If
    If Me.Prix.Value = "" Or Me.Prix.Value = 0 Then
        MsgBox "Vous devez choisir une salle ", vbCritical + vbOKOnly, "Erreur"
        Exit Sub
    End If
 
    Valeur(1) = Val(Num_reser)
    Valeur(2) = Date
    Valeur(3) = Civilité
    Valeur(4) = Nom
    Valeur(5) = Prénom
    Valeur(6) = Adresse
    Valeur(7) = CP
    Valeur(8) = Ville
    Valeur(9) = Téléphone
    Valeur(10) = EMail
    Valeur(11) = List_Salles
    Valeur(12) = DateValue(DTPDateDebut)
    Valeur(13) = DateValue(DTPDateFin)
    Valeur(14) = Cuisine
    Valeur(15) = Option_demi
    Valeur(16) = DateValue(DTPDateFin) - DateValue(DTPDateDebut) + 1
    Valeur(17) = IIf(Nom = "PAROISSE", 0, Prix)
    Valeur(18) = Demi_Apres
    Valeur(19) = Info
    Valeur(20) = Heure_reservation
    Valeur(21) = ActiveCell.Column
 
 
    ecrire_reservation
 
 
 
    Unload Me
 
End Sub

Code feuille planning

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
Private Sub ComboBox2_Change()
        init_date
        Dessin_reservation
End Sub
 
Private Sub Worksheet_Activate()
        Init_Combo
End Sub
 
Private Sub ComboBox1_Change()
        Application.ScreenUpdating = False
        init_date
        Dessin_reservation
        Application.ScreenUpdating = True
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lg As Long, T As Variant
        If Target.Columns.Count > 1 Or Target.Cells.Count > 31 Then Exit Sub
        If Not Intersect(Target, Range("$C$3:$K$33")) Is Nothing Then
                If Cells(Target.Row, ActiveCell.Column).Value = "" Then
                        Modif = False
                        DateDebReser = CDate(Cells(Target.Row, 1).Value)
                        Reservations.DTPDateDebut = DateDebReser
                        DateFinReser = CDate(Cells(Target.Row + Target.Rows.Count - 1, 1).Value)
                        Reservations.DTPDateFin = DateFinReser
                        Reservations.Nbr_jours = (DateValue(Reservations.DTPDateFin) - DateValue(Reservations.DTPDateDebut)) + 1
                        If Reservations.Nbr_jours > 1 Then
                                Reservations.Heure_reservation.Visible = False
                                Reservations.LabelHeure.Visible = False
                        Else
                                 Reservations.Heure_reservation.Visible = True
                                Reservations.LabelHeure.Visible = True
                        End If
                        If ActiveCell.Column = 3 Or ActiveCell.Column = 4 Or ActiveCell.Column = 5 Then
                                Reservations.List_Salles = Cells(2, 3).Value
                        ElseIf ActiveCell.Column = 6 Or ActiveCell.Column = 7 Or ActiveCell.Column = 8 Then
                                Reservations.List_Salles = Cells(2, 6).Value
                        ElseIf ActiveCell.Column = 9 Or ActiveCell.Column = 10 Or ActiveCell.Column = 11 Then
                                Reservations.List_Salles = Cells(2, 9).Value
                         End If
                        Init_Combo_Heure
                        Reservations.Show
                Else
                        Modif = True
                        ligne = Worksheets("Reservations").Range("a1").End(xlDown).Row
'                        Set C = Worksheets("Reservations").Range("A1:A" & ligne).Find(Left(ActiveCell().Value, InStr(ActiveCell().Value, "-") - 1))
                        Set c = Worksheets("Reservations").Range("A1:A" & ligne).Find(ActiveCell().Value)
                        Ligne_ecriture_modification = c.Row
                        With Sheets("reservations")
                                Reservations.Num_reser = .Range("A" & Ligne_ecriture_modification)
                                Reservations.Civilité = .Range("C" & Ligne_ecriture_modification)
                                Reservations.Nom = .Range("D" & Ligne_ecriture_modification)
                                Reservations.Prénom = .Range("E" & Ligne_ecriture_modification)
                                Reservations.Adresse = .Range("F" & Ligne_ecriture_modification)
                                Reservations.CP = .Range("G" & Ligne_ecriture_modification)
                                Reservations.Ville = .Range("H" & Ligne_ecriture_modification)
                                Reservations.Téléphone = .Range("I" & Ligne_ecriture_modification)
                                Reservations.EMail = .Range("J" & Ligne_ecriture_modification)
                                Reservations.DTPDateDebut = .Range("L" & Ligne_ecriture_modification)
                                Date_deb_anc_reser = .Range("L" & Ligne_ecriture_modification)
                                Reservations.DTPDateFin = .Range("M" & Ligne_ecriture_modification)
                                Date_fin_anc_reser = .Range("M" & Ligne_ecriture_modification)
                                Reservations.Cuisine = .Range("N" & Ligne_ecriture_modification)
                                Reservations.Option_demi = .Range("O" & Ligne_ecriture_modification)
                                Reservations.Nbr_jours = .Range("P" & Ligne_ecriture_modification)
                                Reservations.List_Salles = .Range("K" & Ligne_ecriture_modification)
                                Salle_anc_reser = .Range("K" & Ligne_ecriture_modification)
                                Reservations.Demi_Apres = .Range("R" & Ligne_ecriture_modification)
                                Reservations.Info = .Range("S" & Ligne_ecriture_modification)
                                Nbr_jour_1 = .Range("P" & Ligne_ecriture_modification)
                       End With
                                Reservations.Heure_reservation = Format(Sheets("reservations").Range("T" & Ligne_ecriture_modification), "hh:mm")
 
                        Reservations.Prix = Format(Reservations.Nbr_jours * Cout_Salle + IIf(Reservations.Cuisine = True, Cout_Cuisine, 0) + IIf(Reservations.Option_demi = True, Cout_demi, 0) + IIf(Reservations.Demi_Apres = True, Cout_demiApres, 0), "#,##0.00 €")
                        Worksheets("MAD").Range("G1") = ActiveCell().Value
                        Init_Combo_Heure
 
                        Reservations.Show
                End If
       End If
End Sub

La feuille Cfg
Nom : Feuille Cjg.jpg
Affichages : 243
Taille : 70,5 Ko

**Philippe Tulliez** · 31/10/2020, 15h30

Bonjour,
Merci de respecter le balisage des codes que vous publiez, voir le bouton croisillon (#) dans l'éditeur.

Un planning, n'est jamais qu'une représentation, une synthèse de données se trouvant dans une ou plusieurs tables.
Bien organisé ces données est la certitude d'avoir une application pérenne et en utilisant les fonctions et outils natifs d'excel le code VBA se résumerait à quelques lignes de code

La lecture de ce tutoriel de Pierre Fauconnier titré Exercice pratique : Calendrier perpétuel Excel vous inspirera je l'espère.

**ron74** · 09/11/2020, 11h21

bonjour a tous

J'ai suivi vos conseils mais je n'arrive pas à obtenir ce que je veux

J'aimerais obtenir dans la colonne "code" ce qui se trouve en "colonne 1"

en effet la réservation 6 apparait sur 2 jours mais c'est la même réservation

Merci de votre aide

Nom : 2.jpg
Affichages : 299
Taille : 211,4 Ko

Nom : 2.jpg
Affichages : 299
Taille : 211,4 Ko

Amelioration d"un fichier excel de réservation de salle

Macros et VBA Excel

Discussions similaires

Partager

Partager