Pointeuse 35h semaine
Bonjour à toutes et tous,
J'aimerais avoir un fichier Excel avec une macro qui me permet de faire office de Pointeuse. Un bouton qui fasse entree ou sortie à chaque fois que je clique dessus. Chaque début de journée, pause ou fin de journée soit comptabiliser dans une seconde feuille avec le jour de la semaine du lundi au vendredi sur 35h par semaine. Je fais 7h par jour et je voudrais avoir un compte heure qui me dis le temps restant à faire sur mes 35h de la semaine. Et qui me mette par exemple quand je fais que 6h30 dans la journée qui me mette en rouge le restant d'heure à faire et si je fais 7h30 dans la.journée que le restant d'heure soit en vert.
J'espère avoir étais assez claire. Désolé sinon.
Merci d'avance à toutes et tous
Bonjour,
Un début de piste à améliorer. Pour le test tu poses un bouton Formulaire sur la feuille et tu cliques dessus. Les entêtes sont inscrites en premier et formatées ensuite, la date du jour puis l'heure du pointage. Au clic suivant, l'heure du dépointage et les heures faites depuis le clic précédent. Une fois arrivé au vendredi, les totaux des heures faites en journées et semaines seront inscrites en colonne F et G et les cellules seront colorées en fonction. Ici, la feuille cible est la feuille "Feuil1", à adapter :
Sub PointerDepointer()
Dim Fe As Worksheet
Dim LigDeb As Long
Dim LigFin As Long
Dim i As Integer
Dim TotalSem As Double
Dim TotalJour As Double
Dim Entetes
Const Semaine35Heures As Double = 1.45833333333333 '1 / 24 * 35
Const Journee7Heures As Double = 0.291666666666667 '1 / 24 * 7
Set Fe = Worksheets("Feuil1")
'entêtes des colonnes
Entetes = Array("Date", "Jour", "Heure début", "Heure fin", "Delta", "Total jour", "Total semaine")
With Fe
'inscrit les entêtes et les formate
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).Value = Entetes
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).HorizontalAlignment = xlCenter
'sauf les samedis et dimaches
If Weekday(Date, vbMonday) <> 6 And Weekday(Date, vbMonday) <> 7 Then
'défini les lignes pour inscription des dates et heures
LigDeb = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 'sur colonne C
LigFin = .Cells(.Rows.Count, 4).End(xlUp).Row + 1 'sur colonne D
'si la ligne de début (colonne C) est supérieure à la ligne de fin (colonne D) c'est pour un dépointage
If LigDeb > LigFin Then
.Cells(LigFin, 4).Value = Format(Time, "hh:mm:ss") 'inscrit l'heure
.Cells(LigFin, 5).Value = Format(.Cells(LigFin, 4).Value - .Cells(LigFin, 3).Value, "hh:mm:ss") 'calcule le delta en colonne E
'sinon, c'est pour un pointage
Else
.Cells(LigDeb, 1).Value = Date 'inscrit la date
.Cells(LigDeb, 2).Value = Format(Date, "dddd") 'inscrit le jour (lundi, mardi, etc...)
.Cells(LigDeb, 3).Value = Format(Time, "hh:mm:ss") 'inscrit l'heure
End If
'si on est le vendredi
If Weekday(Date, vbMonday) = 5 Then
'boucle sur le tableau
For i = 2 To LigDeb
'si la date de la cellule en cours est la même que la date de la cellule du dessous, commence le total
If .Cells(i, 1).Value = .Cells(i + 1, 1).Value Then
TotalJour = TotalJour + .Cells(i, 5).Value
'sinon, fini le total pour la journée...
Else
TotalJour = TotalJour + .Cells(i, 5).Value
TotalJour = Round(TotalJour, 15)
'inscrit les heures effectuées
.Cells(i, 6).Value = Abs(Journee7Heures - TotalJour)
.Cells(i, 7).NumberFormat = "hh:mm:ss"
'si les 7 heures ne sont pas faites, colore en rouge
If TotalJour < Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 3
'si les 7 heures sont faites, pas de couleur
ElseIf TotalJour = Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 0
'si plus que les 7 heures, colore en vert
ElseIf TotalJour > Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 4
End If
TotalJour = 0
End If
'si la cellule en cours fait partie de la même semaine que la cellule du dessous, commence le total
If DatePart("ww", .Cells(i, 1).Value, 0, 2) = DatePart("ww", .Cells(i + 1, 1).Value, 0, 2) Then
TotalSem = TotalSem + .Cells(i, 5).Value
'sinon, fini le total pour la semaine...
Else
TotalSem = TotalSem + .Cells(i, 5).Value
'inscrit les heures effectuées dans la semaine
.Cells(i, 7).Value = TotalSem
.Cells(i, 7).NumberFormat = "[h]:mm:ss"
'si 35 heures ou plus sont faites, colore en vert
If TotalSem > Semaine35Heures Then
.Cells(i, 7).Interior.ColorIndex = 4
'sinon en rouge
Else
.Cells(i, 7).Interior.ColorIndex = 3
End If
TotalSem = 0
End If
Next i
End If
End If
End With
End SubBonjour Dorierl, Theze,
voici ma version qu'il m'a plu de compliquer à plaisir!
A l'ouverture, la pointeuse détecte une nouvelle semaine ou nouvelle année et adapte l'affichage en fonction avec bilans divers (nouvelle année).
Clic sur le bouton --> Pointeuse ON : le travail commence!
Clic sur le bouton --> Pointeuse OFF : pause! La pointeuse calcule le temps de travail déjà effectué et le temps restant à travailler (rouge : déficit de temps, vert : tu travailles trop!
Ce calcul s'effectue, sauf erreur à l'usage!, en parallèle pour la journée, la semaine et l'année! 8)
Comme j'imagine que tu ne travailleras pas non-stop, tu peux déclarer des jours d'absence : congé, repos (réflexe de mon boulot où on mélange semaine et WE), maladie, grève et autres.
Pour cela, clic sur la journée concernée, en ligne 8 --> le ruban des jours spéciaux s'affiche en lieu et place des jours de semaine : clic, c'est fait! Erreur ? Re-clic sur le jour concerné --> re-clic sur le même jour spécial et il s'annule!
Pourquoi cette fonctionnalité? Ces jours d'absence étant justifiés, la pointeuse leur compte 7h00 'afin d'équilibrer le bilan de la semaine.
Appel de cette fonction par erreur? Clic n'importe où ailleurs annule l'opération sans dommage!
Récapitulons : tu n'as besoin de cliquer QUE sur le bouton ON/OFF pour démarrer le décompte de ton temps de travail et sur la ligne 6 ou 8 pour renseigner des jours d'absence, jours d'absence qui seront comptabilisés lors du bilan annuel.
Les intitulés des jours spéciaux ainsi que leur couleur de police sont paramétrables. Il faut aller à la cellule AA2 pour trouver les données de service : changer un intitulé implique de modifier son initiale correspondante. Faut-il préciser qu'eviter deux initiales identiques est plutôt conseillé ?
Evidemment, abuser de cette facilité en cours d'année empêcherait un calcul correct lors du bilan annuel!
Le ruban de couleur peut être modifié sans dommage pour les calculs. Seul demeurerait l'inconfort d'avoir des couleurs disparates pour un même jour spécial.
Avec plaisir!
Bon travail!
A+