XL 2016 Remplissage automatique des heures depuis un onglet vers un autre

[VInce69340]

Bonjour,

Après une première discussion avec Victor21 que je remercie, j'ai un fichier excel dans lequel je souhaite entre des horaires, avec un onglet par personne, que j'ai appelé ici Personne A et Personne B.

J'aurai voulu, dans un onglet appelé "Pointage" que la Personne puisse cliquer sur son arrivée ou départ et que cela renseigne dans son onglet l'heure actuelle en face de la date du moment.... J'ai créé des boutons pour avoir une idée de ce que je souhaiterai.

J'espère que ma demande est assez claire, et qu'un membre du groupe pourra m'aider !

Merci d'avance

Vincent

 

[AtTheOne]

Bonne nuit à tous, bonne nuit @VInce69340 🥱 😴

J'ai transformé la zone de pointage en tableau structuré (_Tb_Pointage), j'y ai mis deux Mises en Forme Conditionnelles pour visualiser si le pointage a été effectué ou non.

Avec ce code de la feuille pointage, sur un double clic dans une des cellules concernées.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim Heure
     Dim LO As ListObject, Wsh_Salarié As Worksheet, Lgn_Cible
   
     Heure = Time   'Heure de pointage
     If Target.ListObject Is Nothing Then Exit Sub  'Double clic en dehors du tableau
     If Intersect(Target, Me.[_Plage_Pointage]) Is Nothing Then Exit Sub 'Double clic en dehors de la plage de pointage
     Cancel = True    'Annuler l'action du double clic
   
     Set LO = Target.ListObject
     Nom_Feuille = Intersect(LO.ListColumns(1).Range, Target.EntireRow).Value   'Nom de la feuille salarié dans la colonne 1 du tableau
     On Error Resume Next
     Set Wsh_Salarié = Worksheets(Nom_Feuille)
     On Error GoTo 0
     If Wsh_Salarié Is Nothing Then   'Erreur sur le nom de la feuille salarié
          MsgBox "La feuille " & Nom_Feuille & " n'existe pas !"
          Exit Sub
     End If
   
     Lgn_Cible = Application.Match(CLng(Date), Wsh_Salarié.[A:A], 0)  'N° de la ligne Cible
     If IsError(Lgn_Cible) Then  'Date non trouvée
          MsgBox "Date du jour non trouvée dans la feuille " & Nom_Feuille
          Exit Sub
     End If
     Wsh_Salarié.Cells(Lgn_Cible, Target.Column).Value = Heure  'Enregistrement de l'heure de pointage dans la feuille Salarié
   
     MsgBox Title:="POINTAGE " & Nom_Feuille, Prompt:="Heure " & LO.HeaderRowRange.Cells(Target.Column) & " " & Heure & vbCrLf & "Enregistrée"
End Sub

Voir le fichier en PJ

Amicalement
Alain 😴

Modif : Erreur dans le MsgBox final corrigée

 

[VInce69340]

Bonjour et merci pour votre aide ! C'est parfait !
Juste 2 éventuelles modifications :
- Puis-je mettre un texte dans la case à cliquer ?
- Pour une personne de nuit, s'il arrive à 21:00 et repart à 5:00 du matin, la feuille de calcul d'heures le laisse sur la même journée mais dans les colonnes cachées de la personne cela divise sur 2 jours (voir par exemple les 2 premières lignes de 19:00 à 2:00). Cela va-t-il être géré ou cela va passer au jour suivant ? Et si tel est le cas ne va-t-il pas y avoir un souci de décompte d'heures ?

 

[AtTheOne]

Bonjour à tous, bonjour @VInce69340
La réponse et Si, je regarde ...
Peux-tu m'indiquer si la période de pause doit être décomptée des heures de nuit et/ou des heures de jour (Col N et O des onglets Salarié)
A bientôt
Alain

 

[AtTheOne]

Re
Voilà, j'ai laissé tes calcul d'horaire Nuit et Jour tels quels.

J'affiche l'heure de pointage dans la cellule cliquée, une MFC masque cette information le lendemain.

Mais il faudrait faire des contrôles supplémentaires sur les doubles pointages (Pointage déjà effectué) et le bon ordre (d'abord l'arrivée ensuite le début de pause etc ...)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim Jour_Préc As Boolean
     Dim Heure
     Dim LO As ListObject, Wsh_Salarié As Worksheet, Lgn_Cible, Col_Cible As Integer
   
     Heure = Time   'Heure de pointage
     If Target.ListObject Is Nothing Then Exit Sub  'Double clic en dehors du tableau
     If Intersect(Target, Me.[_Plage_Pointage]) Is Nothing Then Exit Sub 'Double clic en dehors de la plage de pointage
     Cancel = True    'Annuler l'action du double clic
   
     Set LO = Target.ListObject
     Nom_Feuille = Intersect(LO.ListColumns(1).Range, Target.EntireRow).Value   'Nom de la feuille salarié dans la colonne 1 du tableau
     On Error Resume Next
     Set Wsh_Salarié = Worksheets(Nom_Feuille)
     On Error GoTo 0
     If Wsh_Salarié Is Nothing Then   'Erreur sur le nom de la feuille salarié
          MsgBox "La feuille " & Nom_Feuille & " n'existe pas !"
          Exit Sub
     End If
     Col_Cible = Target.Column
     Lgn_Cible = Application.Match(CLng(Date), Wsh_Salarié.[A:A], 0)  'N° de la ligne Cible
     If IsError(Lgn_Cible) Then  'Date non trouvée
          MsgBox "Date du jour non trouvée dans la feuille " & Nom_Feuille
          Exit Sub
     End If
   
     'Vérifier que le pointage de Sortie et de Pause se place sur la même ligne que le pointage d'Arrivée :
          'Col_Cible > 2                                    : C'est un pointage Sortie ou Pause
          'Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> ""        : Le pointage d'Arrivée Veille effectué
          'Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "" : Le pointage de Sortie ou Pause de la veille non effectué
     Jour_Préc = (Col_Cible > 2) * (Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> "") * (Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "")
     Lgn_Cible = Lgn_Cible - Abs(JourPrec)
   
     Wsh_Salarié.Cells(Lgn_Cible, Col_Cible).Value = Heure  'Enregistrement de l'heure de pointage dans la feuille Salarié
     Target.Value = Heure
   
     MsgBox Title:="POINTAGE " & Nom_Feuille, Prompt:="Heure " & LO.HeaderRowRange.Cells(Target.Column) & " " & Heure & vbCrLf & "Enregistrée"
End Sub

Vu l'heure, je n'ai pas testé.
A plus tard
Alain

 

[VInce69340]

Encore merci ! Je teste ce we et reviens vers toi pour voir ce qu'il en est !
Pour les heures de pause cela dépend des pauses prises, l'onglet paramètre indiquant les heures de nuit et de jour.

 

[VInce69340]

Bonjour AtTheOne.

J'ai fait un essai ce matin et me retrouve avec un petit souci si par exemple la personne part après minuit, revient puis repart avant minuit.... Son premier départ s'annule. Je mets les copies d'écran en pièces jointes.
Ma question est donc de savoir si la personne arrive avant minuit et repart après minuit, son heure de départ peut-elle s'inscrire sur la même ligne que son arrivée ?
Si pas possible rien de bien grave, tu m'as déjà permis de beaucoup avancé !
Excellentes journée et bon we

 

[AtTheOne]

Bonne Nuit à tous, bonne nuit @VInce69340
J'ai eu un week-end bien occupé ...

Mais il faudrait faire des contrôles supplémentaires sur les doubles pointages (Pointage déjà effectué) et le bon ordre (d'abord l'arrivée ensuite le début de pause etc ...)

Ma question est : ne faut-il pas gérer l'ordre des pointages

1. Arrivée : quelque soit l'heure enregistrement à la date du jour.
2. Début de pause : pas possible si pas de pointage d'arrivée (du même jour ou de la veille)
3. Fin de pause : pas possible si pas de pointage de début de pause (du même jour ou de la veille)
4. Départ : Pas possible si pas de pointage de fin de pause -avec pause obligatoire (du même jour ou de la veille)

Pour les points 2 3 et 4 , si pas de d'arrivée pointée à la date du jour, pointer sur la veille à condition que l'arrivée de la veille soit pointée et que celle du cas considéré (2, 3 ou 4) ne le soit pas la veille. ​

Autre question : Est-ce-que la pause est obligatoire ?
Actuellement je ne fait aucune vérification sur l'ordre des pointages

si par exemple la personne part après minuit, revient puis repart avant minuit.... Son premier départ s'annule

Ma question est donc de savoir si la personne arrive avant minuit et repart après minuit, son heure de départ peut-elle s'inscrire sur la même ligne que son arrivée ?

C'est ce que je pensais avoir fait mais une erreur dans l'orthographie d'un nom de variable et plouf ça ne marchait pas :

Jour_Préc = (Col_Cible > 2) * (Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> "") * (Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "")
Lgn_Cible = Lgn_Cible - Abs(JourPrec)
à remplacer par
Jour_Préc = (Col_Cible > 2) * (Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> "") * (Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "")
Lgn_Cible = Lgn_Cible - Abs(Jour_Préc)

J'ai corrigé dans le fichier joint.
A bientôt,
Amicalement
Alain

 

[VInce69340]

Bonjour Alain

La pause n'est pas obligatoire car elle n'est utilisée que pour les personnes faisant une pause déjeuner, et non les personnes en poste (je sais par expérience qu'ils ne pointeront pas pour aller boire un café !).

Merci pour la correction je vais tester cela depuis le ski où il fait vraiment un mauvais temps aujourd'hui !

Excellente journée

Vincent

 

[VInce69340]

Bonjour Alain.

Le pointage a très bien mzrché

Bonne Nuit à tous, bonne nuit @VInce69340
J'ai eu un week-end bien occupé ...

Ma question est : ne faut-il pas gérer l'ordre des pointages

1. Arrivée : quelque soit l'heure enregistrement à la date du jour.
2. Début de pause : pas possible si pas de pointage d'arrivée (du même jour ou de la veille)
3. Fin de pause : pas possible si pas de pointage de début de pause (du même jour ou de la veille)
4. Départ : Pas possible si pas de pointage de fin de pause -avec pause obligatoire (du même jour ou de la veille)

Pour les points 2 3 et 4 , si pas de d'arrivée pointée à la date du jour, pointer sur la veille à condition que l'arrivée de la veille soit pointée et que celle du cas considéré (2, 3 ou 4) ne le soit pas la veille. ​

Autre question : Est-ce-que la pause est obligatoire ?
Actuellement je ne fait aucune vérification sur l'ordre des pointages



C'est ce que je pensais avoir fait mais une erreur dans l'orthographie d'un nom de variable et plouf ça ne marchait pas :

Jour_Préc = (Col_Cible > 2) * (Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> "") * (Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "")
Lgn_Cible = Lgn_Cible - Abs(JourPrec)
à remplacer par
Jour_Préc = (Col_Cible > 2) * (Wsh_Salarié.Cells(Lgn_Cible - 1, 2) <> "") * (Wsh_Salarié.Cells(Lgn_Cible - 1, Col_Cible) = "")
Lgn_Cible = Lgn_Cible - Abs(Jour_Préc)

J'ai corrigé dans le fichier joint.
A bientôt,
Amicalement
Alain

Alain bonjour,

Tout a bien fonctionné sur le mois de février.

Je passer au mois de mars et ai changé mes dates sur les feuilles individuelles.

Lorsque je valide un pointage à présent j'ai bien une fenêtre de validation du pointage qui apparait, mais ce n'est pas reporté sur la feuille en question.

Je ne vois pas ce qu'il faut changer pour aller reporter au bon endroit.

Si tu as la solution je suis preneur !

Merci d'avance

Vincent

 

[AtTheOne]

Bonjour à toutes et à tous, bonjour @VInce69340
Bon Vincent, j'ai travaillé sur le fichier en PJ de ton post #10.

Le problème venait du fait que la date du jour (1/3/2022) se trouvait une première fois juste sous le mois en lettre (Mars), la macro prenait cette ligne et collait les données dans les entêtes du tableau.

Sur ce point j'ai modifié la zone de recherche dans le code (en partant de A5).
J'ai modifié le calcul du jour dans A5 (plus simple), il se base sur le mois en lettre (A3) et l'année choisie(A2) :
=DATEVAL(1&$A$3&$A$2)-JOURSEM(DATEVAL(1&$A$3&$A$2);3).
J'ai mis une validation "liste" pour choisir le mois et j'ai effacé la date du 1er du mois en A4.

Autre point, j'ai remarqué que le 31 mars n'était pas affiché. du coup j'ai étendu le tableau à six semaines (Cas extrême pour un mois de 31 jours commençant un samedi ou un dimanche par exemple le mois de Mai 2022). Les cellules n'appartenant pas au mois courant sont grisées.

Ensuite j'ai utilisé la fonctionnalité Ligne Total des tableaux structurés pour remplacer tes totaux qui étaient dans le corps du tableau (pas de différence visible).

Dans l'onglet "paramètres" j'ai ajouté un tableau pour recevoir la liste du personnel et j'ai écris deux macros pour créer les feuilles manquantes et réinitialiser toutes les feuilles "personnel" en se basant sur une feuille "Modèle Personnel".

Voilà je pense que je t'ai tout dit ...

Amicalement
Alain