XL 2019 Ecart entre deux dates hors we et féries avec tranche horaire.

MICHDEJONGHE

XLDnaute Nouveau
Bonjour, j'ai récupéré un ancien fichier (Durée Nanette 75) qui me convient bien, il fonctionne parfaitement sauf pour ce qui est des saisies d'heures hors heures
ouvrés, en effet rien n'empêche de saisir une heure de départ avant 9h du matin et saisir une heure de fin après 18h
Peut être une solution en vba ?
Je joins le fichier
Merci
Michel
 

Pièces jointes

  • DuréeMichel.xlsx
    20.1 KB · Affichages: 10

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour MICHDEJONGHE,
Evitez les caractères gras, c'est agressif.:)
Un essai en PJ, la macro s'execute lorsqu'on saisit une heure ou une date. En séparant bien tous les cas de façon que vous puissiez personnaliser les messages d'erreurs avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Or Target = "" Then Exit Sub
    On Error GoTo Fintrait
    ' Début avant 9:00
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target < 9 / 24 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Pas d'heure de début avant 9H00."
        End If
    End If
    ' Jour férié en date début
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Application.CountIf([fériés], Cells(Target.Row, "A")) > 0 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Désolé, c'est un jour férié."
        End If
        ' WE
        If Weekday(Target, 2) >= 6 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Vous bossez le week end, maintenant ?"
        End If
    End If
    ' Fin après 17:00
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Target > 17 / 24 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Pas d'heure de fin après 17H00."
        End If
    End If
    ' Jour férié en date fin
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If Application.CountIf([fériés], Cells(Target.Row, "A")) > 0 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Désolé, c'est un jour férié."
        End If
        ' WE
       
        If Weekday(Target, 2) >= 6 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Vous bossez le week end, maintenant ?"
        End If
    End If
Fintrait:
Application.EnableEvents = True
End Sub
 

Pièces jointes

  • DuréeMichel (1).xlsm
    26.8 KB · Affichages: 5
Dernière édition:

Phil69970

XLDnaute Barbatruc
Bonjoour @MICHDEJONGHE
Edit :Bonjour Sylvain

Quelques remarques :
1)Ecrire tout ton post en gras n'est pas très bien vu sur le forum c'est considérer comme une agression
Tu mets en gras et/ou couleur un ou des passages qui te semble pertinent pour attirer l’œil du lecteur.

2)Comme c'est ta question poste tes besoins et non les besoins d'un autre que tu vas adapter avec plus ou moins de réussite

3)Met ton fichier de ta création et non pas un fichier d'un autre post qui a de grande chance d'être revu car ne correspondant pas complétement à ton vrai besoin. (Evidement tu peux d'en inspirer)
As tu besoin de toutes les colonnes du fichier ?
Ne manque t'il pas une ou des colonnes pour faire ci ou ça ? etc

3)En clair pense comme un vrai cahier charge et anticipe ton/tes besoins futurs ce qui évitera pour toi de tout reprendre tes données dans 6 mois ou 1 an quand tu vas t'apercevoir qu'il te manque par exemple le champ qui te permet de faire ci ou ça.... et pour la personne qui refera ton fichier de tout refaire.

4)Indique clairement ton besoin et tes attendus. Exemple j'ai ceci et je voudrais avoir cela comme résultat dans la cellule ou colonne x ou y .....
Pense aussi à tous las cas de figures que tu pourrais rencontrer mais que nous ne connaissons pas.

En clair post un fichier représentatif de 10 à 20 lignes avec tes attendus (avant/après) ET respectant le RGPD permettrait de comprendre le problème et de t'apporter une ou des réponses.

C'est quoi représentatif ?
- représentatif, même organisation des lignes et des colonnes, mêmes libellés, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ...
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables

*Éventuellement préciser l'ordre de grandeur des lignes à traiter, exemple mon fichier comporte 1 000 lignes ou bien 20 000 lignes ==> la méthodologie peut être différents.

Une demande claire donne très souvent une réponse rapide et qui correspond au mieux à la demande.

Bonne fêtes et bonnes lecture

@Phil69970
 

MICHDEJONGHE

XLDnaute Nouveau
Bonjour MICHDEJONGHE,
Evitez les caractères gras, c'est agressif.:)
Un essai en PJ, la macro s'execute lorsqu'on saisit une heure ou une date. En séparant bien tous les cas de façon que vous puissiez personnaliser les messages d'erreurs avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Or Target = "" Then Exit Sub
    On Error GoTo Fintrait
    ' Début avant 9:00
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target < 9 / 24 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Pas d'heure de début avant 9H00."
        End If
    End If
    ' Jour férié en date début
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Application.CountIf([fériés], Cells(Target.Row, "A")) > 0 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Désolé, c'est un jour férié."
        End If
        ' WE
        If Weekday(Target, 2) >= 6 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Vous bossez le week end, maintenant ?"
        End If
    End If
    ' Fin après 17:00
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Target > 17 / 24 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Pas d'heure de fin après 17H00."
        End If
    End If
    ' Jour férié en date fin
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If Application.CountIf([fériés], Cells(Target.Row, "A")) > 0 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Désolé, c'est un jour férié."
        End If
        ' WE
      
        If Weekday(Target, 2) >= 6 Then
            Application.EnableEvents = False: Target = ""
            MsgBox "Vous bossez le week end, maintenant ?"
        End If
    End If
Fintrait:
Application.EnableEvents = True
End Sub
Bonjour,
Ca marche a merveille, juste un détail
La première date est la date et l'heure de réception d'un mail (chose que le fichier doit accepter, la deuxième date est celle ou le mail a été ouvert.
Sachant que la réception du mail peut être a n'importe quelle heure du jour ou de la nuit, mais la deuxième date se situe pendant les heures de travail.
Merci pour ton aide
 

Phil69970

XLDnaute Barbatruc
Re

Manifestement tu n'as rien lu de ce que j'ai écrit.
1)Ecrire tout ton post en gras n'est pas très bien vu sur le forum c'est considérer comme une agression
Même Sylvain te l'as écrit
Evitez les caractères gras, c'est agressif.

Et je ne parle même pas du reste de mon message qui est resté sans réponse .
C'est avec des comportements comme cela que la qualité de ce forum se dégrade.....

Bonne fêtes

@Phil69970
 

MICHDEJONGHE

XLDnaute Nouveau
Re
Désolé mais je n'ai pas répondu en caractères gras, deuxièmement je t'ai dis que j'avais fait des test et que ca fonctionnait parfaitement
Je ne vois pas ce que je peux faire de mieux, ou bien je n'ai pas compris
Ceci dit encore un grand merci pour votre aide.
Passez de bonnes fêtes.
Michel
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
je ne sais pas comment cloturer ce dossier
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin