Pointage (date & heure)

Bonjour

Je dois réaliser un fichier de pointage d'un groupe de personne. Je souhaiterai que quand la personne devant pointer, sélectionne son nom dans une liste que l'on peut modifier à souhait et une fois son nom sélectionné, celle-ci clique sur le bouton "présent" et qu'il y ait un message de confirmation de son pointage. Ce pointage (date et heure minute seconde) devra s'inscrire dans une feuille d'historique.

Je souhaiterai aussi que la personne ne puisse pointer qu'une seule et unique fois par jour.

Pouvez vous m'aider svp ?

Merci à vous d'avance

112pointage-jsp.xlsm (26.19 Ko)

Bonjour,

Une solution sans passez par un USERFORM, mais via double clic sur votre plage. Code à placer dans le module de la feuille BDD :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With ActiveSheet
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    If Not Application.Intersect(Target, .Range(.Cells(2, 1), .Cells(LR, 1))) Is Nothing Then
        If MsgBox("Confirmez vous le pointage de " & Target & " à " & Now, vbInformation + vbOKCancel) = vbOK Then
            With Worksheets("Historique pointage")
                LR = .Cells(.Rows.Count, 1).End(xlUp).Row
                NOM_C = "'Historique pointage'!A1:A" & LR
                DATE_C = "'Historique pointage'!B1:B" & LR
                If Application.Evaluate("=COUNTIFS(" & NOM_C & ",""" & Target & """," & DATE_C & "," & CLng(Date) & ")") > 0 Then
                    MsgBox "Pointage déjà réalisé ce jour pour cette personne", vbCritical
                    Else
                    .Cells(LR, 1).Offset(1) = Target
                    .Cells(LR, 2).Offset(1) = Date
                    .Cells(LR, 3).Offset(1) = CDate(Now - Date)
                    MsgBox "Pointage enregistré", vbInformation
                End If
            End With
        End If
    End If
End With
Cancel = True
End Sub

Je vous laisse tester et revenir vers moi le cas échéant.

Cdlt,

Bonjour Ergotamine

Je vais tester. Je reviens vers toi pour te donner mon impression.

Re Ergotamine

Ton code fonctionne bien.

Est il possible de le faire en code vba afin que je puisse soumettre les 2 exemplaires de fichiers de pointage à mes supérieurs ? Eux seuls prendront la décision.

Merci encore pour ce code.

Bonjour

Bonjour à tous

Une variante.

Option Explicit

Dim f As Worksheet, tabloH
Dim i&, ln&, dte As Date, dteHMS, nom$

Private Sub CommandButton1_Click()

    If ListBox1.ListIndex = -1 Then
        MsgBox "Vous devez sélectionner votre nom.", 16
        Exit Sub
    End If
    dte = Date
    dteHMS = Now
    nom = ListBox1
    For i = 1 To UBound(tabloH, 1)
        If tabloH(i, 1) = nom And tabloH(i, 2) = dte Then
            MsgBox "Vous avez déjà été pointé à " & Format(Range("C" & i), "hh,mm,ss")
            Unload Me
            Exit Sub
        End If
    Next i
    ln = UBound(tabloH, 1) + 1
    Range("A" & ln) = nom
    Range("B" & ln) = dte
    Range("C" & ln) = Format(Now, "hh:mm:ss")
    Unload Me
End Sub

Private Sub UserForm_initialize()

    Set f = Sheets("Bdd")
    tabloH = Range("A1").CurrentRegion
    ListBox1.List = f.Range("A2:A" & f.Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

Bye !

Bonjour !

Merci gmb de continuer à faire l'effort de mettre ton code dans le texte de ta réponse. C'est vraiment très appréciable

Bonjour Gmb

Ton code est GENIAL.

Juste un petit détail: Peux tu mettre le bouton de commande "pointer" (en bleu) en feuille 3 stp ?

Un GRAND GRAND MERCI.

Nouvelle version

105pointage-jsp-v2.xlsm (36.45 Ko)
Option Explicit

Dim f As Worksheet, fh As Worksheet, tabloH
Dim i&, ln&, dte As Date, dteHMS, nom$

Private Sub CommandButton1_Click()

    If ListBox1.ListIndex = -1 Then
        MsgBox "Vous devez sélectionner votre nom.", 16
        Exit Sub
    End If
    dte = Date
    dteHMS = Now
    nom = ListBox1
    For i = 1 To UBound(tabloH, 1)
        If tabloH(i, 1) = nom And tabloH(i, 2) = dte Then
            MsgBox "Vous avez déjà été pointé à " & Format(fh.Range("C" & i), "hh,mm,ss")
            Unload Me
            Exit Sub
        End If
    Next i
    ln = UBound(tabloH, 1) + 1
    fh.Range("A" & ln) = nom
    fh.Range("B" & ln) = dte
    fh.Range("C" & ln) = Format(Now, "hh:mm:ss")
    Unload Me
End Sub

Private Sub UserForm_initialize()

    Set f = Sheets("Bdd")
    Set fh = Sheets("Historique pointage")
    tabloH = fh.Range("A1").CurrentRegion
    ListBox1.List = f.Range("A2:A" & f.Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

Bye

@ JoyeuxNoel
Avec plaiisir !
Bye !

Bonjour,

Re Ergotamine

Ton code fonctionne bien.

Est il possible de le faire en code vba afin que je puisse soumettre les 2 exemplaires de fichiers de pointage à mes supérieurs ? Eux seuls prendront la décision.

Merci encore pour ce code.

Je n'ai pas compris, c'est un code VBA .. Après il diffère un peu car ne passe pas par un USF, mais je trouvais ça plus simple, ça évite des manipulation supplémentaires (chargement des valeurs dans l'USF, etc ...) pour une tâche répétitive. Mais c'est sûr que ça ne répond pas exactement à la demande via le fichier transmis, je comprend.

Cdlt,

Bonjour GMB

Vraiment Nickel pour la Version 2. C'est exactement ce que je souhaitais. Merci beaucoup.

Merci à toi aussi Ergotamine pour ton aide.

Rechercher des sujets similaires à "pointage date heure"