Discussion :

[Richard58]

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

[Menhir]

des erreurs se glissent dans ma programmation.

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

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/

[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.

[riaolle]

Bonjour,

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

Code :

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

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.

[Patrice740]

Bonjour le Fil

Il est plus propre d'écrire :

Code :

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

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

ou

Code :

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

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

[Richard58]

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

Voici le code

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
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

[riaolle]

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 :

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

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 :

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
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

[Richard58]

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

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
'--------------------------------------------------------------------------------
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

[riaolle]

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

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 :

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

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 :

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

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 :

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
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 :

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
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