Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

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


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Comment créer un planning avec liste déroulante?
    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


  2. #2
    Expert confirmé
    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:


    Le fichier


    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

  3. #3
    Futur Membre du Club
    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

  4. #4
    Expert confirmé
    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.


    Cdlt

  5. #5
    Futur Membre du Club
    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

  6. #6
    Expert confirmé
    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.


    Cdlt

  7. #7
    Futur Membre du Club
    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

  8. #8
    Expert confirmé
    Pourrais-vous déposer le fichier dans données confidentielles?

  9. #9
    Futur Membre du Club
    Avec plaisir mais comment faire?

  10. #10
    Expert confirmé
    Bonjour,

    Comme ceci


    Cdlt

  11. #11
    Futur Membre du Club
    Bonjour ARTURO83,

    Voici le liens et merci




  12. #12
    Expert confirmé
    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

  13. #13
    Futur Membre du Club
    MERCI ARTURO83,

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

  14. #14
    Futur Membre du Club
    C'est bon ARTURO83, ça fonctionne bien.

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

    Merci

  15. #15
    Futur Membre du Club
    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




  16. #16
    Expert confirmé
    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:


    ainsi de suite pour d'autres couleurs

    je vous retourne le fichier


    Cdlt

  17. #17
    Futur Membre du Club
    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

  18. #18
    Expert confirmé
    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

  19. #19
    Futur Membre du Club
    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


  20. #20
    Expert confirmé
    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

###raw>template_hook.ano_emploi###