Comment créer un planning avec liste déroulante?

**stef2807** · 21/07/2020, 23h12

Bonjour, je souhaite créer un planning horaire avec une liste déroulante pour déterminer le début et la fin de l'horaire de mes collègues avec une sélection de couleur pour déterminer leurs tâches.

Est-ce possible?

voici l'exemple du tableau ci-dessous.

Merci

stef2807

TEST PLANNING.xlsx

**ARTURO83** · 22/07/2020, 06h34

Bonjour,

Voici une proposition, sélectionnez une des cellules du tableau en lien avec le nom d'une personne, puis cliquez sur le gros bouton.
Exemple en vidéo:
Pièce jointe 575548

Le fichier
Pièce jointe 575549

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
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
Sub Saisie_Horaires()
    Dim H_Deb As String, H_Fin As String, Couleur As String
    Dim hdeb As Object, hfin As Object
    Dim R As Byte, V As Byte, B As Byte
    Dim Lig As Long
 
    Application.ScreenUpdating = False
    If Cells(Selection.Row, "A") = "" Then Exit Sub 'Si la ligne sélectionnée ne contient pas de nom d'employé
    H_Deb = Application.InputBox("Saisir l'heure de début sous la forme 7h00", , , , , , , 2)
    If H_Deb = "" Then Exit Sub
    If InStr(1, H_Deb, "h", 1) = 0 Then 'on vérifie si la saisie est conforme aux heures inscrites en entête du tableau
        MsgBox "Veuillez saisir le format de l'heure sous cette forme ""7h00"" ou ""10h00"""
        Exit Sub
    End If
        If Right(H_Deb, 2) <> "00" And Right(H_Deb, 2) <> "30" Then
        MsgBox "L'heure saise n'est pas conforme à celles enregistrée en entête du tableau"
        Exit Sub
    End If
 
    H_Fin = Application.InputBox("Saisir l'heure de fin sous la forme 10h30", , , , , , , 2)
    If H_Fin = "" Then Exit Sub
    If InStr(1, H_Deb, "h", 1) = 0 Then
        MsgBox "Veuillez saisir le format de l'heure sous cette forme ""7h00"" ou ""10h00"""
        Exit Sub
    End If
    If Right(H_Fin, 2) <> "00" And Right(H_Fin, 2) <> "30" Then
        MsgBox "L'heure saise n'est pas conforme à celles enregistrée en entête du tableau"
        Exit Sub
    End If
 
    Couleur = Application.InputBox("saisir le N° de la couleur parmi celles-ci (1:Gris, 2:Bleu, 3:Vert, 4:Jaune", , , , , , , 2)
    If Couleur = "" Then Exit Sub
    Select Case Couleur
        Case 1 'gris
            R = 175
            V = 171
            B = 171
        Case 2 'bleu
            R = 0
            V = 112
            B = 192
        Case 3 'vert
            R = 146
            V = 208
            B = 80
        Case 4 'jaune
            R = 255
            V = 255
            B = 0
    End Select
 
    Lig = ActiveCell.Row
    Set hdeb = Rows(2).Find(H_Deb)
    Set hfin = Rows(2).Find(H_Fin)
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column)).Value = 30 'on applique la valeur de 30mn sur toute la plage horaire
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column)).Interior.Color = RGB(R, V, B) 'on applique la couleur choisie sur toute la plage horaire
 
    Set hdeb = Nothing
    Set hfin = Nothing
End Sub
 
Sub Suppression_Plage_Horaire()
    If Selection.Row < 2 Or Selection.Column < 2 Or Selection.Column > 30 Then Exit Sub
    Selection.Interior.ColorIndex = xlNone
    Selection.ClearContents
End Sub

Cdlt

**stef2807** · 23/07/2020, 09h34

Bonjour ARTURO83,

Merci pour ta proposition c'est exactement ce que je recherche.

Néanmoins, je ne suis pas un pro du VBA. Si tu as un tuto pour créer des boutons que j'adapterai à ce que tu m'a propsé?

Meriiiiiiiii

**ARTURO83** · 23/07/2020, 10h07

Bonjour

Néanmoins, je ne suis pas un pro du VBA. Si tu as un tuto pour créer des boutons que j'adapterai à ce que tu m'a propsé?

Voilà une des façons de faire.
Pièce jointe 575671

Cdlt

**stef2807** · 24/07/2020, 21h37

Bonsoir ARTURO83,

Merci pour ton retour mais ça ne fonctionne pas...

J'ai appliqué ta méthode tel que tu me l'a envoyé et mes bouton "Saisie horaire" et "Effacer la plage horaire" ne fonctionne pas.

Il y a quelque chose que je n'ai certainement pas bien fait.

Il me met un message d'erreur dont tu trouvera l'image en pièce jointe.

Merci

**ARTURO83** · 25/07/2020, 06h40

Bonjour,

Vous avez collé le code au mauvais endroit.
Lorsque vous faites ALT + F11 pour accéder à la fenêtre VBA, il faut cliquer sur "Insertion", sélectionnez "Module", un nouveau module s'affiche "Module1" et c'est dans la partie droite de ce module qu'on y colle le code.
Pièce jointe 575814

Cdlt

**stef2807** · 25/07/2020, 10h10

Bonjour ARTURO83,

Merci pour ta réponse mais j'ai le même code erreur.

Il y a forcément quelque chose que je fais mal ou pas.

Merci

**ARTURO83** · 25/07/2020, 10h20

Pourrais-vous déposer le fichier dans données confidentielles?

**stef2807** · 26/07/2020, 00h23

Avec plaisir mais comment faire?

**ARTURO83** · 26/07/2020, 05h17

Bonjour,

Comme ceci
Pièce jointe 575851

Cdlt

**stef2807** · 26/07/2020, 12h05

Bonjour ARTURO83,

Voici le liens et merci

test planning 2.xlsm

**ARTURO83** · 26/07/2020, 12h14

Bonjour,

C'est parce que vous avez déplacé le tableau de la ligne 2 à la ligne 7, il faut remplacer

Code :

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

1
2
    Set hdeb = Rows(2).Find(H_Deb)
    Set hfin = Rows(2).Find(H_Fin)

par

Code :

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

1
2
    Set hdeb = Rows(7).Find(H_Deb)
    Set hfin = Rows(7).Find(H_Fin)

Cdlt

**stef2807** · 26/07/2020, 13h03

MERCI ARTURO83,

ça a fonctionner une fois et ensuite j'ai de nouveau le même code d'erreur

**stef2807** · 26/07/2020, 13h39

C'est bon ARTURO83, ça fonctionne bien.

Si je veux rajouter des couleurs ça se passe comment?

Merci

**stef2807** · 26/07/2020, 14h36

Je te renvois mon fichier terminer car je souhaite reporter le code sur chaque jour de la semaine avec un calcul automatique des heures prestées.

Comment faire pour que chaque jour fonctionne?

Merci ARTURO83

test planning 2.xlsm

**ARTURO83** · 26/07/2020, 19h10

Comment faire pour que chaque jour fonctionne?

La macro est unique et n'est pas nominative, elle sert pour toutes les feuilles, donc il était inutile de la recopier dans tous les modules.

Pour les couleurs, cela se passe ici

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
    Select Case Couleur
        Case 1 'gris
            R = 175
            V = 171
            B = 171
        Case 2 'bleu
            R = 0
            V = 112
            B = 192
        Case 3 'vert
            R = 146
            V = 208
            B = 80
        Case 4 'jaune
            R = 255
            V = 255
            B = 0
    End Select

Pour vous aider à en rajouter, voici une petite vidéo sur le principe
Supposions que vous vouliez ajouter la couleur violette, il faut connaître comment obtient le violet, faire comme ceci:
Pièce jointe 575883

ainsi de suite pour d'autres couleurs

je vous retourne le fichier
Pièce jointe 575884

Cdlt

**stef2807** · 26/07/2020, 19h43

Super ARTURO83 LE PRO

Dernière petite chose.

Le total des heure, j'ai toujours 30 min en trop. Si je preste de 8h00 à 12h00 le calcul en bout de ligne me donne 4h30 et non 4h00 puisqu'il sélectionne à partir des cases 8h00 jusqu'à 12h00 et donc 9 cases au lieu de 8. Tu aurais un moyen pour régler ça?

Merci

**ARTURO83** · 27/07/2020, 04h34

Bonjour,

Code :

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

=SI(NBVAL(B8:AD8)=0;"";(SI(NBVAL(B8:AD8)=1;0,5;(NBVAL(B8:AD8)-1)/2)))

En fait, lorsqu'on saisie une heure de fin, par exemple 12h00, il faudrait que la plage s'arrête à la cellule de 11h30, puisque la plage occupée par la cellule s'étend de 11h30 à 12h00, donc la fin est la butée de la plage des 11h30 soit 12h00, ainsi on ne touche pas à la formule.

Si cela vous convient et si cela vous parait plus logique, il suffit de remplacer les 2 lignes suivantes:

Code :

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

1
2
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column )).Value = 30 'on applique la valeur de 30mn sur toute la plage horaire
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column )).Interior.Color = RGB(R, V, B) 'on applique la couleur choisie sur toute la plage horaire

par

Code :

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

1
2
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column - 1)).Value = 30 'on applique la valeur de 30mn sur toute la plage horaire
    Range(Cells(Lig, hdeb.Column), Cells(Lig, hfin.Column - 1)).Interior.Color = RGB(R, V, B) 'on applique la couleur choisie sur toute la plage horaire

Cdlt

**stef2807** · 27/07/2020, 11h28

Bonjour ARTURO83,

Encore merci pour tes explication mais il serait possible d'inverser? c-à-d plutôt de terminer la cellule avant, démarrer une cellule plus tard.

Donc pour la plage de 8h00 à 12h00 que ce soit de la plage 8h30 à 12h00.

Encore mille merci ARTURO83

**ARTURO83** · 27/07/2020, 11h44

Pas de problème, ceci

Code :

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

1
2
    Range(Cells(Lig, hdeb.Column + 1), Cells(Lig, hfin.Column)).Value = 30 'on applique la valeur de 30mn sur toute la plage horaire
    Range(Cells(Lig, hdeb.Column + 1), Cells(Lig, hfin.Column)).Interior.Color = RGB(R, V, B) 'on applique la couleur choisie sur toute la plage horaire

Comment créer un planning avec liste déroulante? [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager