Fichier de réservation

Version imprimable

29/04/2020, 11h19
Richard58

2 pièce(s) jointe(s)

Fichier de réservation

Bonjour à tous,

J'essaie de faire une petite application de réservation d'installation à la semaine voir à l'année mais des erreurs se glissent dans ma programmation. J'ai besoin de votre aide.

Je m’inspire d'une appli que j'ai téléchargé. (fichier de départ)

Je met en pièce jointe mon fichier de base avec lequel j'essaie de faire le mien.

Pouvez m'aider à faire fonctionner mon fichier intitulé essai réservation ?

Ah, j'oubliais, je suis débutant en code VBA et c'est ma première création de fichier. J'ai déjà créer des formulaire mais beaucoup plus simple

Merci
29/04/2020, 13h33
Menhir

Citation:

Envoyé par Richard58

des erreurs se glissent dans ma programmation.

Serait-il possible d'en savoir un peu plus sur ces "erreurs" ?

Citation:

Je met en pièce jointe mon fichier de base avec lequel j'essaie de faire le mien.

Beaucoup de participants actifs de ce forum n'ouvre pas les fichiers joints.
A lire : https://www.developpez.net/forums/d8...s-discussions/
29/04/2020, 13h43
Richard58

La première erreur arrive quand je veux créer une nouvelle feuille, je n'arrive pas à la nommer avec le nom que je souhaite.
On appelle une installation sportive dans une listes, la page doit s'ouvrir avec le nom de l'installation.
29/04/2020, 15h16
riaolle
Bonjour,

Citation:

quand je veux créer une nouvelle feuille, je n'arrive pas à la nommer avec le nom que je souhaite.
Code:

1 2 3 4 Sub nouvelleFeuille() ThisWorkbook.Sheets.Add ActiveSheet.Name = "nouveau nom" End Sub
Pour le reste, je n'ouvre pas les pièces jointes pour des raisons de sécurité (https://www.developpez.net/forums/d8...s-discussions/)
Il faudrait que tu nous donnes le code sur lequel tu as des problèmes (utilise les balises code => bouton # dans le menu).

Dis-nous si tu as un erreur. Si oui, laquelle et où.
Si tu n'as pas d'erreur, qu'est-ce qui ne fonctionne pas comme tu le voudrais ?
N'hésites pas à joindre des copies d'écran de ton classeur pour nous aider à comprendre la structure de ton classeur si cela peut aider.

Bonjour le Fil

Il est plus propre d'écrire :

Code:

1
2
3
4
5
Sub nouvelleFeuille()
Dim wsh As Worksheet
  Set wsh = ThisWorkbook.Worksheets.Add
  wsh.Name = "nouveau nom"
End Sub

Code:

1
2
3
Sub nouvelleFeuille()
  ThisWorkbook.Worksheets.Add.Name = "nouveau nom"
End Sub

Hello,
Et merci de s’intéresser à mon cas

Voici le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub ComboBox2_AfterUpdate()
   Sheets("Modele").Select
    Sheets("Modele").Copy after:=Sheets("Modele")
    Sheets("Modele (2)").Select
    Sheets("Modele (2)").Name = NomSalle
    Sheets("listes").Select
    Range("A1").Select
    If ActiveCell.Value = "" Then
        ActiveCell.Value = NomSalle
        Sheets("liste").Select
        Exit Sub
    End If
    If ActiveCell.Offset(1, 0).Value = "" Then
        ActiveCell.Offset(1, 0).Value = NomSalle
    Else
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Value = NomSalle
    End If
End Sub

Re-bonjour,

1ère chose : évite d'utiliser Select/ Activate etc ... Cela peut entraîner rapidement des problèmes et ne sert à rien. L'enregistreur de macro en met partout, mais il faut nettoyer le code après. Donc chez toi, ça ferait ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub ComboBox2_AfterUpdate()
    Sheets("Modele").Copy after:=Sheets("Modele")
    Sheets("Modele (2)").Name = NomSalle
 
    If Sheets("listes").Range("A1").Value = "" Then
        Sheets("listes").Range("A1").Value = NomSalle
        Exit Sub
    End If
 
    If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
        Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
    Else
        Sheets("listes").Range("A1").End(xlDown).Offset(1, 0).Value = NomSalle
    End If
End Sub

2ème chose : tu utilises une variable qui n'a pas de valeur. Que vaut NomSalle ? Tu ne le dis jamais dans ton code ? Est-ce que c'est la valeur de ComboBox2 ? Dans ce cas, il faut le dire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub ComboBox2_AfterUpdate()
    Dim NomSalle As String
    NomSalle = ComboBox2     
 
    Sheets("Modele").Copy after:=Sheets("Modele")
    Sheets("Modele (2)").Name = NomSalle
 
    If Sheets("listes").Range("A1").Value = "" Then
        Sheets("listes").Range("A1").Value = NomSalle
        Exit Sub
    End If
 
    If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
        Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
    Else
        Sheets("listes").Range("A1").End(xlDown).Offset(1, 0).Value = NomSalle
    End If
End Sub

=> tout sur les Combobox

Merci Riaolle, cela fonctionne parfaitement
Par contre, quand je valide il ne se passe rien, donc si tu peux m'aider encore

Code:

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
'--------------------------------------------------------------------------------
Private Sub Valider_Click()
Dim hde As String
Dim ha As String
Dim valhde As String
Dim valha As String
 
'Reservation.Hide
'Application.ScreenUpdating = False
lafeuille = gymnase.Value
lassociation = association.Value
lejour = jour.Value
lheurede = "'" & heurede.Value
lheurea = "'" & heurea.Value
 
Call TraitementAssoc
 
Sheets("Recap").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ligne = ActiveCell.Row
ActiveCell.Value = lafeuille
ligne = ActiveCell.Row
Cells(ligne, 2).Select
ActiveCell.Value = lassociation
 
 
Sheets("Recap").Select
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(lafeuille).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é!!!"
    Sheets("Récap").Select
    Range("A1").End(xlDown).Offset(0, 0).Select
    Selection.EntireRow.Delete
    Sheets(lafeuille).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

Cela fonctionne parfaitement, mais rien ne se passe ? ... Alors ça ne fonctionne pas parfaitement :mouarf:

1. Attention aux Select et Activate !!! Débarasse-toi de ceux-ci, car ils peuvent vite entraîner des problèmes. En plus, ça va simplifier ton code, donc ce sera plus simple de comprendre où est-ce qu'il y a une erreur.

2. Est-ce que gymnase, association, jour, heurede, heurea sont des cellules nommées ?
Tu passes par des variables intermédiaires (lafeuille, lassociation, lejour, lheurede, lheurea). Si tu veux, mais c'est pas vraiment utile.

3. Je ne comprends pas ce que tu fais avec hde et ha ? Je te retranscris ce que tu écris :

Code:

1
2
3
Cells(ligne, 5).Select
ActiveCell.Value = lheurea
ha = ActiveCell.Value

Du coup, par transitivité ha = lheurea, non ?
Attention, dans ton code tu multiplies les variables. Ce n'est pas faux, mais tu as un tas de variables qui ne sont pas vraiment utiles ou redondantes. Tu risques de t'emmêler les pattes.

4. Attention parfois, tu écris Sheets("Recap") et parfois Sheets("Récap"). Quel est le bon nom ?

5. Quand tu écris ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
'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

Est-ce que ton but est de trouver la cellule en colonne A qui contient la valeur hde ? Alors ne passe pas par une boucle ! Il y a plus simple et plus rapide => Find.

6. Dans l'ensemble des Case, je comprends que tu cherches s'il y a une cellule non vide. Idem n'utilise pas une boucle, mais l'équivalent en VBA de NBVAL.
=> NBVAL = compte le nombre de cellules non vides dans une plage
=> équivalent en VBA : Application.CountA

7. Offset(0,0) ne sert à rien.

En corrigeant tout ça, on obtient :

Code:

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
Private Sub Valider_Click()
    Dim hde As String
    Dim ha As String
    Dim valhde As String
    Dim valha As String
 
    Dim lignede As Variant
    Dim plageSel As Range
 
    'Reservation.Hide
    'Application.ScreenUpdating = False
    lafeuille = gymnase.Value
    lassociation = association.Value
    lejour = jour.Value
    lheurede = "'" & heurede.Value
    lheurea = "'" & heurea.Value
 
    Call TraitementAssoc
 
    With Sheets("Recap")
        ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
 
        .Range("A" & ligne).Value = lafeuille
        .Cells(ligne, 2).Value = lassociation
        .Cells(ligne, 3).Value = lejour
        .Cells(ligne, 4).Value = lheurede
        .Cells(ligne, 5).Value = lheurea
    End With
 
    With Sheets(lafeuille)
        'Détermination de la ligne de et de la ligne à pour le planing
        lignede = .Range("A:A").Find(lheurede).Row
        If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
 
        lignea = .Range("A:A").Find(lheurea).Row
        If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
 
        'Recherche dans planing si la plage a affecter est deja prise
        vide = 0
        Select Case lejour
            Case "Lundi"
                If Application.CountA(Range(.Cells(lignede, 3), .Cells(lignea, 3))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 3), .Cells(lignea, 3))
 
            Case "Mardi"
                If Application.CountA(Range(.Cells(lignede, 4), .Cells(lignea, 4))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 4), .Cells(lignea, 4))
 
            Case "Mercredi"
                If Application.CountA(Range(.Cells(lignede, 5), .Cells(lignea, 5))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 5), .Cells(lignea, 5))
 
            Case "Jeudi"
                If Application.CountA(Range(.Cells(lignede, 6), .Cells(lignea, 6))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 6), .Cells(lignea, 6))
 
            Case "Vendredi"
                If Application.CountA(Range(.Cells(lignede, 7), .Cells(lignea, 7))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 7), .Cells(lignea, 7))
 
            Case "Samedi"
                If Application.CountA(Range(.Cells(lignede, 8), .Cells(lignea, 8))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 8), .Cells(lignea, 8))
 
            Case "Dimanche"
                If Application.CountA(Range(.Cells(lignede, 9), .Cells(lignea, 9))) > 0 Then vide = 1
                Set plageSel = Range(.Cells(lignede, 9), .Cells(lignea, 9))
 
        End Select
    End With
 
    If vide = 1 Then
        MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
        Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
        Exit Sub
    End If
 
    'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
    plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
    With plageSel
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With plageSel.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
        plageSel.Value = lassociation
End Sub

Ton Case alourdi beaucoup le code => tu fais exactement la même chose pour chaque cas, seulement la colonne change. En fait, que ce soit pour Case ou une condition If, si tu te rends compte que tu fais exactement la même chose dans chaque condition, à une variable prêt, c'est que tu peux sûrement simplifier. Ici, tu peux prendre une variable col qui te permettra juste de récupérer la colonne en fonction du jour.

Code:

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
Private Sub Valider_Click()
    Dim hde As String
    Dim ha As String
    Dim valhde As String
    Dim valha As String
 
    Dim lignede As Variant
    Dim plageSel As Range
    Dim col As Integer
 
    'Reservation.Hide
    'Application.ScreenUpdating = False
    lafeuille = gymnase.Value
    lassociation = association.Value
    lejour = jour.Value
    lheurede = "'" & heurede.Value
    lheurea = "'" & heurea.Value
 
    Call TraitementAssoc
 
    With Sheets("Recap")
        ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
 
        .Range("A" & ligne).Value = lafeuille
        .Cells(ligne, 2).Value = lassociation
        .Cells(ligne, 3).Value = lejour
        .Cells(ligne, 4).Value = lheurede
        .Cells(ligne, 5).Value = lheurea
    End With
 
    With Sheets(lafeuille)
        'Détermination de la ligne de et de la ligne à pour le planing
        lignede = .Range("A:A").Find(lheurede).Row
        If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
 
        lignea = .Range("A:A").Find(lheurea).Row
        If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
 
        'Recherche dans planing si la plage a affecter est deja prise
        vide = 0
        Select Case lejour
            Case "Lundi"
                col = 3
            Case "Mardi"
                col = 4
            Case "Mercredi"
                col = 5
            Case "Jeudi"
                col = 6
            Case "Vendredi"
                col = 7
            Case "Samedi"
                col = 8
            Case "Dimanche"
                col = 9
        End Select
 
        If Application.CountA(Range(.Cells(lignede, col), .Cells(lignea, col))) > 0 Then vide = 1
        Set plageSel = Range(.Cells(lignede, col), .Cells(lignea, col))
 
    End With
 
    If vide = 1 Then
        MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
        Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
        Exit Sub
    End If
 
    'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
    plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
    With plageSel
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With plageSel.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
        plageSel.Value = lassociation
End Sub

Tout cela est à tester pas à pas :)

04/05/2020, 15h30
Richard58

5 pièce(s) jointe(s)

Bonjour,
Merci à Riaolle de s’intéresser à mon cas.

J'explique le but de mon fichier. Il s'agit d'un fichier récapitulant le planning d’utilisation des installations sportives à la semaine.
On ouvre le fichier et j'arrive sur cette page
Pièce jointe 562746

Je crée l'association qui fait la demande et ensuite je clique sur réservation, un formulaire s'ouvre :
Pièce jointe 562747
Toutes les listes ont été crées (la liste association au fur et à mesure)
Pièce jointe 562748

Une fois que j'ai rempli ce formulaire, j'aimerai qu'une feuille planning se crée (sauf si elle existe déjà). Sur cette feuille doit apparaître le créneau entré dans le formulaire.
Pièce jointe 562751
Et tous les renseignements doivent être récapituler dans une autre feuille.
Pièce jointe 562756

Donc pour résumer, lorsque je clique sur valider, soit la feuille planning se crée (si elle n'existe pas), et elle se remplie. De plus, on doit vérifier la disponibilité du créneau.

Voilà, c'est assez complexe
04/05/2020, 17h50
riaolle

As-tu essayé ce que je te proposes dans mon message précédent ?
Si oui, qu'est-ce qui ne fonctionne pas comme tu le voudrais ?
05/05/2020, 11h33
Richard58

J'ai un probleme avec la ligne lafeuille

J'ai également un probleme quand je veux entrer un autre créneau sur le même gymnase. Pour lui, il doit créer une feuille à chaque fois
05/05/2020, 11h48
riaolle
Il faudrait que tu sois plus précis, que tu nous décrives quel est ton problème. Un message d'erreur ? Si oui, lequel ? Quelque chose qui ne fonctionne pas comme tu voudrais ?

Citation:

J'ai un probleme avec la ligne lafeuille

Est-ce que gymnase, association, jour, heurede, heurea sont des cellules nommées ? Je pose la question, car tu écris :
Code:

1 2 3 4 5 lafeuille = gymnase.Value lassociation = association.Value lejour = jour.Value lheurede = "'" & heurede.Value lheurea = "'" & heurea.Value
Mais à aucun moment avant, tu ne détermines ce que sont gymnase, association, jour, heurede, heurea.

Citation:

Pour lui, il doit créer une feuille à chaque fois

A aucun moment dans le code, il n'y a une instruction disant qu'il faut créer une feuille (Sheets.Add). Je ne vois donc pas comment cela est possible. Es-tu sûr que ce n'est pas plutôt dans "TraitementAssoc" qu'il y a ça ?

Code:

1
2
3
4
5
lafeuille = gymnase.Value
lassociation = association.Value
lejour = jour.Value
lheurede = "'" & heurede.Value
lheurea = "'" & heurea.Value

lafeuille correspond à la feuille avec nom de salle
l'association correspond au nom de l'association
lejour correspond au jour de réservation
lheurede correspond à l'heure de début
heudea correspond à l'heure de fin

Voici le code complet du formulaire réservation avec celui que tu me propose

Code:

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
Private Sub ComboBox2_AfterUpdate()
    Dim NomSalle As String
    NomSalle = ComboBox2
 
    Sheets("Modele").Copy after:=Sheets("Modele")
    Sheets("Modele (2)").Name = NomSalle
 
    If Sheets("listes").Range("A2").Value = "" Then
        Sheets("listes").Range("A2").Value = NomSalle
        Exit Sub
        End If
         If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
        Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
    Else
 
    End If
 
 
End Sub
 
Private Sub CommandButton2_Click()
Reservation.Hide
Sheets("Menu").Select
End Sub
 
Private Sub UserForm_Activate()
' Utilisation de l'option AddItem
    Dim Arr() As String
    Dim ArrH() As String
    Dim I As Integer, NbSheets As Integer
    Dim ListeGym As Object
    Dim ListeJour As Object
    Dim ListeHreDe As Object
    Dim ListeHreA As Object
    Dim ListeAssoc As Object
 
'Definition des matrices
 
Worksheets("Menu").Select
    Set ListeGym = Worksheets("listes").Range("A1").Resize(Worksheets("listes").Range("A1").CurrentRegion.Rows.Count - 1, 1)
    NbGymnases = Application.CountA(Sheets("listes").Range("A1").EntireColumn)
    Reservation.ComboBox2.Clear
    ReDim Arr(1 To NbGymnases)
    For I = 1 To NbGymnases
        Arr(I) = ListeGym(I).Value
    Reservation.ComboBox2.AddItem Arr(I)
    Next
    ComboBox2.ListIndex = 0
 
    Set ListeAssoc = Worksheets("listes").Range("E1").Resize(Worksheets("listes").Range("E1").CurrentRegion.Rows.Count - 1, 1)
    NbAssoc = Application.CountA(Sheets("listes").Range("E1").EntireColumn)
    Reservation.ComboBox1.Clear
    ReDim Arr(1 To NbAssoc)
    For I = 1 To NbAssoc
        Arr(I) = ListeAssoc(I).Value
    Reservation.ComboBox1.AddItem Arr(I)
    Next
    ComboBox1.ListIndex = 0
 
 
    Set ListeJour = Worksheets("listes").Range("C1").Resize(Worksheets("listes").Range("C1").CurrentRegion.Rows.Count - 1, 1)
    NbJours = Application.CountA(Sheets("listes").Range("C1").EntireColumn)
    Reservation.ComboBox3.Clear
    ReDim Arr(1 To NbJours)
    For I = 1 To NbJours
        Arr(I) = ListeJour(I).Value
    Reservation.ComboBox3.AddItem Arr(I)
    Next
    ComboBox3.ListIndex = 0
 
    Set ListeHreDe = Worksheets("Listes").Range("D1").Resize(Worksheets("listes").Range("D1").CurrentRegion.Rows.Count - 1, 1)
    NbHreDe = Application.CountA(Sheets("listes").Range("D1").EntireColumn)
    Reservation.ComboBox4.Clear
    ReDim ArrH(1 To NbHreDe)
    For I = 1 To NbHreDe
        ArrH(I) = ListeHreDe(I).Value
    Reservation.ComboBox4.AddItem ArrH(I)
    Next
    ComboBox4.ListIndex = 0
 
    Set ListeHreA = Worksheets("Listes").Range("D1").Resize(Worksheets("listes").Range("D1").CurrentRegion.Rows.Count - 1, 1)
    NbHreA = Application.CountA(Sheets("listes").Range("D1").EntireColumn)
    Reservation.ComboBox5.Clear
    ReDim ArrH(1 To NbHreA)
    For I = 1 To NbHreA
        ArrH(I) = ListeHreA(I).Value
    Reservation.ComboBox5.AddItem ArrH(I)
    Next
    ComboBox5.ListIndex = 0
 
 
End Sub
'--------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
    Dim hde As String
    Dim ha As String
    Dim valhde As String
    Dim valha As String
 
    Dim lignede As Variant
    Dim plageSel As Range
    Dim col As Integer
 
    'Reservation.Hide
    'Application.ScreenUpdating = False
    lafeuille = gymnase.Value
    lassociation = association.Value
    lejour = jour.Value
    lheurede = "'" & heurede.Value
    lheurea = "'" & heurea.Value
 
    Call TraitementAssoc
 
    With Sheets("Recap")
        ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
 
        .Range("A" & ligne).Value = lafeuille
        .Cells(ligne, 2).Value = lassociation
        .Cells(ligne, 3).Value = lejour
        .Cells(ligne, 4).Value = lheurede
        .Cells(ligne, 5).Value = lheurea
    End With
 
    With Sheets(lafeuille)
        'Détermination de la ligne de et de la ligne à pour le planing
        lignede = .Range("A:A").Find(lheurede).Row
        If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
 
        lignea = .Range("A:A").Find(lheurea).Row
        If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
 
        'Recherche dans planing si la plage a affecter est deja prise
        vide = 0
        Select Case lejour
            Case "Lundi"
                col = 3
            Case "Mardi"
                col = 4
            Case "Mercredi"
                col = 5
            Case "Jeudi"
                col = 6
            Case "Vendredi"
                col = 7
            Case "Samedi"
                col = 8
            Case "Dimanche"
                col = 9
        End Select
 
        If Application.CountA(Range(.Cells(lignede, col), .Cells(lignea, col))) > 0 Then vide = 1
        Set plageSel = Range(.Cells(lignede, col), .Cells(lignea, col))
 
    End With
 
    If vide = 1 Then
        MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
        Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
        Exit Sub
    End If
 
    'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
    plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
    With plageSel
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With plageSel.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
        plageSel.Value = lassociation
End Sub
'-------------------------------------------------
Sub TraitementAssoc()
Sheets("Listes").Select
Columns("D:D").Select
On Error GoTo ajoute
Selection.Find(wath:=lassociation, after:=ActiveCell, LookIn:=xlFormulas, _
    lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
    MatchCase:=False).Activate
Range("D1").Select
Exit Sub
ajoute:
'Ajout de la nouvelle association dans la liste deroulante et tri de la matrice
Range("D1").End(xlDown).Offset(1, 0).Value = lassociation
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=hlguess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("D1").Select
End Sub

J'ai aussi un module de traitement générale

Code:

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
Sub ListeFeuilles()
Dim ligne As Integer
Dim Lst() As String
Dim I As Integer
'Création de la liste des onglets (sauf les 3 derniers)
'                                  Récap, Listes et Menu
ReDim Lst(Sheets.Count - 1)
Sheets("listes").Select
For I = 0 To Sheets.Count - 1
    ligne = ligne + 1
    Lst(I) = Sheets(I + 1).Name
    If I < Sheets.Count - 4 Then
        Cells(ligne, 1).Select
        ActiveCell.Value = Lst(I)
    End If
Next I
End Sub
'--------------------------------------------------------------------------------
Sub auto_open()
'Macro s'executant a l'ouverture du classeur
Call ListeFeuilles
Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------
Sub Imprime()
'Imprime la feuille selectionnée
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub
'--------------------------------------------------------------------------------
Sub VersMenu()
'Retour vers la feuille Menu
Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------
Sub VersRécap()
'Aller dans la feuille Récap
Sheets("Récap").Select
End Sub
'--------------------------------------------------------------------------------
Sub AfficheBtGym()
'Afficher la boite de dialogue du choix du gymnase
BoiteGymnase.Show
End Sub
'--------------------------------------------------------------------------------
Sub AfficheBtAssoc()
'Afficher la boite de dialogue du choix de l'association
BoiteAssoc.Show
End Sub
'--------------------------------------------------------------------------------
Sub AfficheReservation()
'Refait la matrice des feuilles (Gymnases)
Call ListeFeuilles
Sheets("Menu").Select
'Afficher la boite de dialogue de la planification
Reservation.Show
End Sub
'--------------------------------------------------------------------------------
Sub RétablirBase()
'Rétablit la base Récap apres selection d'une association
Selection.AutoFilter Field:=2
Selection.AutoFilter
End Sub
'--------------------------------------------------------------------------------
Sub efface()
'Suppression d'une réservation
ligne = ActiveCell.Row
msg = "Etes-vous sûr de vouloir supprimer la ligne " & ligne & " ??"
Style = vbYesNo + vbDefaultButton1
titre = "ATTENTION!!!!!"
réponse = MsgBox(msg, Style, titre)
If réponse = vbYes Then
    'Si reponse est égale a Oui
    'Mise dans variables du contenu des cellules de la ligne de
    'Récap à supprimer
    Cells(ligne, 1).Select
    lafeuille = ActiveCell.Value
    Cells(ligne, 2).Select
    lassociation = ActiveCell.Value
    Cells(ligne, 3).Select
    lejour = ActiveCell.Value
    Cells(ligne, 4).Select
    lheurede = ActiveCell.Value
    hde = ActiveCell.Value
    Cells(ligne, 5).Select
    lheurea = ActiveCell.Value
    ha = ActiveCell.Value
    'Selection de la feuille du gymnase auquel la ligne appartient
    Sheets(lafeuille).Select
    'Reconstitution de la plage horaire
    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
    ' selection dans la feuille gymnase de la plage horaire
    ' en fonction du jour
    Select Case lejour
        Case "Lundi"
            Range(Cells(lignede, 3), Cells(lignea, 3)).Select
        Case "Mardi"
            Range(Cells(lignede, 4), Cells(lignea, 4)).Select
        Case "Mercredi"
            Range(Cells(lignede, 5), Cells(lignea, 5)).Select
        Case "Jeudi"
            Range(Cells(lignede, 6), Cells(lignea, 6)).Select
        Case "Vendredi"
            Range(Cells(lignede, 7), Cells(lignea, 7)).Select
        Case "Samedi"
            Range(Cells(lignede, 8), Cells(lignea, 8)).Select
        Case "Dimanche"
            Range(Cells(lignede, 9), Cells(lignea, 9)).Select
    End Select
 
    'Suppression de la fusion de cellules
    'Remise en place des lignes horizontales
    'Suppression du contenu
 
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .ShrinkToFit = False
            .MergeCells = False
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        Selection.ClearContents
        Range("A3").Select
    'Suppression de la ligne dans la feuille Récap
    Sheets("Recap").Select
    Selection.EntireRow.Delete
 
End If
End Sub
'-------------------------------------------------------------
Sub AjoutAssociation()
    NomAssoc = InputBox("Indiquez le nom de l'association", "Ajout d'une Association")
    Sheets("listes").Select
    Range("E2").Select
    If ActiveCell.Value = "" Then
        ActiveCell.Value = NomAssoc
        Sheets("Menu").Select
        Exit Sub
    End If
    If ActiveCell.Offset(1, 0).Value = "" Then
        ActiveCell.Offset(1, 0).Value = NomAssoc
    Else
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Value = NomAssoc
    End If
    Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------

Ouuuh 8O il y a beaucoup de choses !

Je ne vois toujours pas quand tu affectes des valeurs à gymnase, association, jour, heurede, heurea. A aucun moment tu ne dis par exemple :

Code:

1
2
3
gymnase = Range("A1").Value
'.... ou ....
gymnase = TextBox1

Je ne comprends comment VBA peut savoir à quoi correspondent gymnase, association, jour, heurede, heurea. Est-ce que ce sont des cellules nomées ? Est-ce que ce sont des noms de TextBox ?

2-3 conseils sur ton code.

As-tu bien compris ce que fait Offset ?
Sheets("listes").Range("A2").Value est strictement équivalent à Sheets("listes").Range("A1").Offset(1, 0).Value
Donc quand tu écris :

Code:

1
2
3
4
5
6
7
8
9
If Sheets("listes").Range("A2").Value = "" Then
        Sheets("listes").Range("A2").Value = NomSalle
        Exit Sub
        End If
         If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
        Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
    Else
 
    End If

Tu écris 2 fois la même chose.

Attention dans un de tes Find, tu as écris wath au lieu de what => ça ne peut pas fonctionner.

Dans UserForm_Activate :
je ne sais pas vraiment utiliser CurrentRegion, mais d'après ce que j'ai compris, tu remplis tes ComboBox avec le contenu de différente colonne. A mon avis tu peux faire plus simple/court avec RowSource. Je t'ai mis ça dans le code ci-dessous.

Je t'ai corrigé certaines choses et j'ai commenté pas mal de choses :

Code:

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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
Private Sub ComboBox2_AfterUpdate()
    Dim NomSalle As String
    NomSalle = ComboBox2
 
    Sheets("Modele").Copy after:=Sheets("Modele")
    Sheets("Modele (2)").Name = NomSalle
 
    If Sheets("listes").Range("A2").Value = "" Then Sheets("listes").Range("A2").Value = NomSalle
End Sub
 
Private Sub CommandButton2_Click()
    Reservation.Hide
    Sheets("Menu").Select
End Sub
 
Private Sub UserForm_Activate()
 
Worksheets("Menu").Select
 
    With Sheets("listes")
       Reservation.ComboBox2.Clear
       ComboBox2.RowSource = "listes!A1:A" & Application.CountA(.Range("A:A"))
       ComboBox2.ListIndex = 0
 
       Reservation.ComboBox1.Clear
       ComboBox1.RowSource = "listes!E1:E" & Application.CountA(.Range("E:E"))
       ComboBox1.ListIndex = 0
 
       Reservation.ComboBox3.Clear
       ComboBox3.RowSource = "listes!C1:C" & Application.CountA(.Range("C:C"))
       ComboBox3.ListIndex = 0
 
       Reservation.ComboBox4.Clear
       ComboBox4.RowSource = "listes!D1:D" & Application.CountA(.Range("D:D"))
       ComboBox4.ListIndex = 0
 
       Reservation.ComboBox5.Clear
       ComboBox5.RowSource = "listes!D1:D" & Application.CountA(.Range("D:D"))
       ComboBox5.ListIndex = 0
    End With
 
 
End Sub
'--------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
    Dim hde As String
    Dim ha As String
    Dim valhde As String
    Dim valha As String
 
    Dim lignede As Variant
    Dim plageSel As Range
    Dim col As Integer
 
    'Reservation.Hide
    'Application.ScreenUpdating = False
    lafeuille = gymnase.Value           'là je comprends toujours pas ce qu'est gymnase ???
    lassociation = association.Value
    lejour = jour.Value
    lheurede = "'" & heurede.Value
    lheurea = "'" & heurea.Value
 
    Call TraitementAssoc
 
    With Sheets("Recap")
        ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
 
        .Range("A" & ligne).Value = lafeuille
        .Cells(ligne, 2).Value = lassociation
        .Cells(ligne, 3).Value = lejour
        .Cells(ligne, 4).Value = lheurede
        .Cells(ligne, 5).Value = lheurea
    End With
 
    With Sheets(lafeuille)
        'Détermination de la ligne de et de la ligne à pour le planing
        lignede = .Range("A:A").Find(lheurede).Row
        If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
 
        lignea = .Range("A:A").Find(lheurea).Row
        If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
 
        'Recherche dans planing si la plage a affecter est deja prise
        vide = 0
        Select Case lejour
            Case "Lundi"
                col = 3
            Case "Mardi"
                col = 4
            Case "Mercredi"
                col = 5
            Case "Jeudi"
                col = 6
            Case "Vendredi"
                col = 7
            Case "Samedi"
                col = 8
            Case "Dimanche"
                col = 9
        End Select
 
        If Application.CountA(Range(.Cells(lignede, col), .Cells(lignea, col))) > 0 Then vide = 1
        Set plageSel = Range(.Cells(lignede, col), .Cells(lignea, col))
 
    End With
 
    If vide = 1 Then
        MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
        Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
        Exit Sub
    End If
 
    'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
    plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
    With plageSel
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = True
    End With
    With plageSel.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
        plageSel.Value = lassociation
End Sub
'-------------------------------------------------
Sub TraitementAssoc()
    'ici pareil => comment sait-on ce qu'est "lassocation"  dans le Find???
    'évite les select/ activate et compagnie
    'est-on assuré que la cellule active est bien celle après laquelle on veut chercher ? Cf. "after:=ActiveCell"
 
    Dim trouve As Variant
 
    Set trouve = Sheets("Listes").Columns("D:D").Find(what:=lassociation, after:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
        MatchCase:=False)
 
    If Not trouve Is Nothing Then   'si trouve n'est pas rien = si on a trouve qqc
        trouve.Select
    Else
    'Ajout de la nouvelle association dans la liste deroulante et tri de la matrice
    Sheets("Listes").Range("D1").End(xlDown).Offset(1, 0).Value = lassociation
    Sheets("Listes").Columns("D:D").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=hlguess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If
End Sub
 
 
Sub ListeFeuilles()
Dim I As Integer
'Création de la liste des onglets (sauf les 3 derniers)
'                                  Récap, Listes et Menu
 
'Evite les Select et Activate !!
'Pourquoi passes-tu par une liste ??? Pourquoi n'écris-tu pas directement la valeur dans la cellule ?
'Tu fais une boucle For de 0 à Sheets.Count-1, puis tu n'inscris la feuille que si I < Sheets.Count-4. Pourquoi ne fais-tu pas tout
'simplement une boucle de 0 à Sheets.Count-4 ?
'Dans ton exemple ligne vaut la même chose que I, puisque tu ajoutes 1 à ligne à chaque itération de la boucle. Donc pas besoin de la variable "ligne".
 
    For I = 0 To Sheets.Count - 4
        Sheets("listes").Cells(I, 1).Value = Sheets(I + 1).Name
    Next I
 
End Sub
'--------------------------------------------------------------------------------
Sub auto_open()
'Macro s'executant a l'ouverture du classeur
Call ListeFeuilles
Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------
Sub Imprime()
'Imprime la feuille selectionnée
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub
'--------------------------------------------------------------------------------
Sub VersMenu()
'Retour vers la feuille Menu
Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------
Sub VersRécap()
'Aller dans la feuille Récap
Sheets("Récap").Select
End Sub
'--------------------------------------------------------------------------------
Sub AfficheBtGym()
'Afficher la boite de dialogue du choix du gymnase
BoiteGymnase.Show
End Sub
'--------------------------------------------------------------------------------
Sub AfficheBtAssoc()
'Afficher la boite de dialogue du choix de l'association
BoiteAssoc.Show
End Sub
'--------------------------------------------------------------------------------
Sub AfficheReservation()
'Refait la matrice des feuilles (Gymnases)
Call ListeFeuilles
Sheets("Menu").Select
'Afficher la boite de dialogue de la planification
Reservation.Show
End Sub
'--------------------------------------------------------------------------------
Sub RétablirBase()
'Rétablit la base Récap apres selection d'une association
Selection.AutoFilter Field:=2
Selection.AutoFilter
End Sub
'--------------------------------------------------------------------------------
Sub efface()
'Suppression d'une réservation
ligne = ActiveCell.Row
msg = "Etes-vous sûr de vouloir supprimer la ligne " & ligne & " ??"
Style = vbYesNo + vbDefaultButton1
titre = "ATTENTION!!!!!"
reponse = MsgBox(msg, Style, titre)         'évite les accents et autres caractères spéciaux dans tes variables => ça peut entraîner des problèmes
If reponse = vbYes Then
    'Si reponse est égale a Oui
    'Mise dans variables du contenu des cellules de la ligne de
    'Récap à supprimer
 
'Evite les Activate et Select !!!!
    lafeuille = Cells(ligne, 1).Value
    lassociation = Cells(ligne, 2).Value
    lejour = Cells(ligne, 3).Value
    lheurede = Cells(ligne, 4).Value
    hde = Cells(ligne, 4).Value     'pourquoi 2 variables avec exactement la même valeur ???
    lheurea = Cells(ligne, 5).Value  'idem ?
    ha = Cells(ligne, 5).Value
    'Selection de la feuille du gymnase auquel la ligne appartient
 
    With Sheets(lafeuille)
       'Reconstitution de la plage horaire
 
                ' recherche d'un terme => Find
 
 
       'je ne comprends pas : tu fais 2 recherches à la suite et tu attribus le résultat de la recherche à la même variable.
       'du coup la variable est écrasée par la 2ème recherche ???
       'A quoi doit correspondre lig ? => je pense que tu t'es trompé et qu'une recherche est lignede et l'autre lignea
 
       lignde = .Range("A4:A" & Rows.Count).Find(hde).Row
       lignea = .Range("A4:A" & Rows.Count).Find(ha).Row
 
 
       ' selection dans la feuille gymnase de la plage horaire
       ' en fonction du jour
 
       'idem pas de select/activate etc
 
       Select Case lejour
           Case "Lundi"
                col = 3
           Case "Mardi"
               col = 4
           Case "Mercredi"
               col = 5
           Case "Jeudi"
               col = 6
           Case "Vendredi"
               col = 7
           Case "Samedi"
               col = 8
           Case "Dimanche"
               col = 9
       End Select
 
       'Suppression de la fusion de cellules
       'Remise en place des lignes horizontales
       'Suppression du contenu
 
           With .Range(.Cells(lignede, col), .Cells(lignea, col))
               .HorizontalAlignment = xlGeneral
               .VerticalAlignment = xlBottom
               .WrapText = False
               .Orientation = 0
               .ShrinkToFit = False
               .MergeCells = False
 
               .Borders(xlDiagonalDown).LineStyle = xlNone
               .Borders(xlDiagonalUp).LineStyle = xlNone
 
                With .Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With .Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                .ClearContents
           End With
 
        End With
    'Suppression de la ligne dans la feuille Récap
    Sheets("Recap").Range("A" & ligne).EntireRow.Delete
 
End If
End Sub
'-------------------------------------------------------------
Sub AjoutAssociation()
 
    'Pas de Select et Activate !
    'Utilise la syntaxe If...ElseIf...Else plutôt que des If avec des Exit Sub
 
    NomAssoc = InputBox("Indiquez le nom de l'association", "Ajout d'une Association")
    With Sheets("listes").Range("E2")
        If .Value = "" Then
            .Value = NomAssoc
        ElseIf .Offset(1, 0).Value = "" Then
            .Offset(1, 0).Value = NomAssoc
        Else
            .End(xlDown).Offset(1, 0).Value = NomAssoc
        End If
    End With
    Sheets("Menu").Select
End Sub
'--------------------------------------------------------------------------------

Mais j'ai toujours pas compris l'histoire de certaines variables. D'où viennent-elles ? A quel moment sont-elles définies ??

As-tu testé tout tes Sub les uns après les autres, pas à pas ?
Quand on code, il faut y aller pas à pas. Coder un peut, tester, si ça fonctionne et continuer seulement si ce qu'on a codé jusqu'à présent fonctionne.
Ton code est long et je ne sais pas où sont les erreurs. Il est donc difficile de donner une solution sûre.

05/05/2020, 17h22
Patrice740

Bonjour riaolle,

Citation:

Envoyé par riaolle

Je ne vois toujours pas quand tu affectes des valeurs à gymnase, association, jour, heurede, heurea.

Voilà pourquoi je reponds très rarement quand le module ne commence pas par Option Explicit et pourquoi je conseille que les variables soient préfixée :
Typographie variables VBA
le code est tellement plus simple à lire.