Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système

NONO14 · Samedi à 15:41

Bonjour à toutes et à tous,
Me revoilà avec une nouvelle discussion. Voici mon problème.
Dans un formulaire UfPointage il y a un bouton qui doit servir à enregistrer l'heure système dans une feuille "Planning" dans un TS ("t_BDD").
Pour ce faire, on doit rechercher le code agent (Txt_Code) dans le TS, colonne "Code agent" qui est la 1ère colonne du TS, mais également rechercher si il y a déjà eu un pointage à la date du TextBox (TxB_DateJour). Si c'est le cas, alors on recherche le dernier pointage, le premier étant dans la colonne 6 (Pointage 1) et les autres à la suite jusqu'à la colonne 11 (Pointage 6).
De plus, lorsque l'on saisie le Code agent dans la Txt_Code, la ListBox (Lst_Pointage) doit se remplir des pointages déjà réalisés dans la semaine pour cet agent, si il y en a.
La ListBox doit contenir le N° semaine (Colonne 4 du TS, "Semaine") et la date de pointage. Les TextBox (Txt_Point 1 à 6) reçoivent les heures de pointages qui pourront être modifiées si besoin. Pour le moment, la ListBox et les Txt_Point sont Enabled=True. Ils seront rendu modifiable en cliquant sur le bouton modifier, mais ça on verra plus tard.
J'ai commencé un bout de code pour le remplissage du TS mais je ne sais pas comment faire pour la recherche du dernier pointage.
Merci par avance pour votre aide

VB:

Private Sub Cmb_Entrée_Click()
Dim Ctrl As Control
Dim TrouvLig As Boolean
Dim TrouvDerLig As Boolean

    If Me.Txt_Code.Value = "" Then 'Si la TextBox est vide, un message d'alerte dans le Label information
        Me.Lbx_Information.Caption = "Vous devez renseigner votre code"
        Exit Sub
    End If
   
    DeProtege ("Planning") 'On déprotège la feuille de calcul "Planning"
   
    With Sheets("Planning").ListObjects("t_BDD") 'On utilise la feuille et son TS pour les recherches et les saisies
   
    TrouvLig = False
       
        For i = 1 To ListRows.Count 'Pour chaque ligne du TS on recherche le code agent et la date
                If .ListColumns("Code agent").DataBodyRange(i) = Me.Txt_Code And .ListColumns("Dat").DataBodyRange(i) = Me.TxB_DateJour Then
            Ligne = i
    TrouvLig = True
       
        Exit For
                End If
        Next i
       
            If Not TrouvLig Then 'Si on a pas trouvé la ligne, on créé une nouvelle ligne
                Ligne = .ListRows.ass.Index
            End If
           
'On écrit les infos dans le TS
    .DataBodyRange(Ligne, 1) = Me.Txt_Code
    .DataBodyRange(Ligne, 2) = Me.Txt_Noms
    .DataBodyRange(Ligne, 3) = Me.Txt_Prénom

'Là je ne sait plus comment faire pour rechercher le dernier pointage à partir de la colonne 11 jusqu'à la 6
       
End Sub

NONO14 · Hier à 09:39

TooFatBoy à dit:
Ça n'a aucun intérêt.

As-tu calculé, en gros, combien de lignes aurait ton TS au bout d'un an s'il n'était pas vidé ?

Donc tu veux dire que vous ne gardez aucune trace des pointages au-delà de deux mois ?!?

Franchement, il faut vraiment que ton donneur d'ordre arrête de mettre son nez dans ce projet !
Quel est l'intérêt de vider le tableau tous les jours ???
Ça fait du code à créer en plus pour rien, donc temps de développement du projet allongé et complexité de la maintenance augmentée, etc.

Les tableaux précédents sont conservés par le comptable, de ce fait il y a toujours une trace. Ils sont archivés pendant 5 ans.

NONO14 · Hier à 09:43

TooFatBoy à dit:

Je te propose ceci :

VB:

Private Sub Txt_Code_Change()
'
Dim Ligne As ListRow
Dim CodeRecherche As String
Dim NbLigTS As Long, NumLigTS As Long, NumLigListBox As Long
Dim i As Integer

    Me.Txt_Code.Text = UCase(Me.Txt_Code)

    ' On récupère le contenu de la Txt_Code
    CodeRecherche = Me.Txt_Code.Value

    ' On recherche le code dans la 1ère colonne du TS "t_Noms"
    For Each Ligne In Range("t_Noms").ListObject.ListRows

        ' Si le code agent est trouvé
        If Ligne.Range(1, 1).Value = CodeRecherche Then

            ' On récupère le contenu des 2e et 3e colonnes dans Txt_Noms
            Me.Txt_Noms.Value = Ligne.Range(1, 2).Value
            Me.Txt_Prénom.Value = Ligne.Range(1, 3).Value
            ' On vide la ListBox
            UfPointage.Lst_Pointage.Clear
            ' On dénombre les lignes du TS
            NbLigTS = Range("t_BDD").ListObject.ListRows.Count
            NumLigListBox = -1
            For NumLigTS = 1 To NbLigTS
                If Range("t_BDD[Code agent]")(NumLigTS).Value = CodeRecherche And Range("t_BDD[Semaine]")(NumLigTS).Value = WorksheetFunction.IsoWeekNum(Date) Then
                    NumLigListBox = NumLigListBox + 1
                    ' On ajoute une ligne à la ListBox
                    UfPointage.Lst_Pointage.AddItem
                    ' On écrit la date dans la première colonne de la ListBox
                    UfPointage.Lst_Pointage.Column(0, NumLigListBox) = Range("t_BDD[Date]")(NumLigTS).Text
                    ' On écrit les heures de pointage de la 2e à la 7e colonne de la ListBox
                    For i = 1 To 6
                        UfPointage.Lst_Pointage.Column(i, NumLigListBox) = Range("t_BDD")(NumLigTS, i + 5).Text
                    Next i
                End If
            Next NumLigTS
            Exit For

        ' Si le code agent n'est pas trouvé
        Else

            Me.Txt_Noms.Value = ""
            Me.Txt_Prénom.Value = ""
            UfPointage.Lst_Pointage.Clear

        End If

    Next Ligne

End Sub

A quoi sert ce code dans ton fichier exemple, n'est-il pas un doublon ?

VB:

Sub Remplir_t_Saisie(LeCodeAgent As String)
    
    ' On vide la ListBox
    UfPointage.Lst_Pointage.Clear
    
    ' On dénombre les lignes du TS
    NbLigTS = Range("t_BDD").ListObject.ListRows.Count
    NumLigListBox = -1
    For NumLigTS = 1 To NbLigTS
        If Range("t_BDD[Code agent]")(NumLigTS).Value = LeCodeAgent And Range("t_BDD[Semaine]")(NumLigTS).Value = WorksheetFunction.IsoWeekNum(Date) Then
            NumLigListBox = NumLigListBox + 1
            
            ' On ajoute une ligne à la ListBox
            UfPointage.Lst_Pointage.AddItem
            
            ' On écrit la date dans la première colonne de la ListBox
            UfPointage.Lst_Pointage.Column(0, NumLigListBox) = Range("t_BDD[Date]")(NumLigTS).Text
            
            ' On écrit les heures de pointage de la 2e à la 7e colonne de la ListBox
            For i = 1 To 6
                UfPointage.Lst_Pointage.Column(i, NumLigListBox) = Range("t_BDD")(NumLigTS, i + 5).Text
            Next i
        End If
    Next NumLigTS

End Sub

ChTi160 · Hier à 10:42

Bonjour le Fil

Un seul tableau de 7000 lignes c'est peu !
une question:
je n'ai pas encore compris le fonctionnement ! voir Vidéo
Ma demande lorsque j'arrive à ce stade , sur le Userform "UfPointage" que dois je faire pour répondre à l'objectif de ce Userform (Pointer)
si tu peux me donner des exemple de ce que l'on a et ce que l'on veut !
Jean marie

NONO14 · Hier à 10:55

ChTi160 à dit:
Bonjour le Fil

Un seul tableau de 7000 lignes c'est peu !
une question:
je n'ai pas encore compris le fonctionnement ! voir Vidéo
Ma demande lorsque j'arrive à ce stade , sur le Userform "UfPointage" que dois je faire pour répondre à l'objectif de ce Userform (Pointer)
si tu peux me donner des exemple de ce que l'on a et ce que l'on veut !
Jean marie

Bonjour,
Lorsque l'agent ouvre le formulaire, il tape son code, dans la ListBox s'affiche tous ses pointages de la semaine et dans les TextBox "Txt_Point" les pointages de la journée et ensuite il clique sur le bouton de pointage, pour lui ça s'arrête là jusqu'à son prochain pointage.
A l'aide du bouton "modifier", (cette partie n'est pas encore codée), l'administrateur pourra modifier n'importe quel pointage de la semaine et uniquement de la semaine en cours. Donc il doit pouvoir cliquer sur une ligne de la ListBox et les données horaires, pas la date, s'afficheront dans les Txt_Point pour être modifiés et remplacer ceux déjà enregistrés.

Voici la dernière mouture du fichier, je suis entrain de travailler sur les en-têtes de la ListBox.

ChTi160 · Hier à 12:51

Re
Que doit il y avoir dans les TextBox "Txt_PointX"
et comment ça ce passe Lol?
jean marie

NONO14 · Hier à 12:55

ChTi160 à dit:
Re
Que doit il y avoir dans les TextBox "Txt_PointX"
et comment ça ce passe Lol?
jean marie

Dans les Txt_PointX il doit y avoir les pointages du jour. Si toutes les cases sont remplies alors l'agent est informé qu'il ne peut plus pointer, le bouton de pointage est rendu Enabled=false (code pas encore fait)

NONO14 · Hier à 13:28

Voici le code qui a été mis en place pour le formulaire UfPointage à partir de la Txt_Code.
Ce n'est pas parfait je vous l'accorde, mais ça fonctionne.

VB:

Private Sub Txt_Code_Change()
Dim Ligne As ListRow
Dim CodeRecherche As String
Dim NbLigTS As Long, NumLigTS As Long, NumLigListBox As Long
Dim i As Integer

    Me.Txt_Code.Text = UCase(Me.Txt_Code)

    ' On récupère le contenu de la Txt_Code
    CodeRecherche = Me.Txt_Code.Value

    ' On recherche le code dans la 1ère colonne du TS "t_Noms"
    For Each Ligne In Range("t_Noms").ListObject.ListRows

        ' Si le code agent est trouvé
        If Ligne.Range(1, 1).Value = CodeRecherche Then
        
        'On regarde si il y a encore des pointages réalisables
        If Len(Me.Txt_Point1.Text) > 0 And Len(Me.Txt_Point2.Text) > 0 And Len(Me.Txt_Point3.Text) > 0 And Len(Me.Txt_Point4.Text) > 0 And Len(Me.Txt_Point5.Text) > 0 And Len(Me.Txt_Point6.Text) > 0 Then
        'si c'est le cas le bouton de pointage est inutilisable
        'et on informe l'agent qu'il ne peut plus pointer
            Me.Cmb_Entrée.Enabled = False
            Me.Lbx_Information.Caption = "Vous ne pouvez plus pointer pour cette journée"
        Else
            'Sinon l'agent peut pointer
            Me.Cmb_Entrée.Enabled = True
            Me.Lbx_Information.Caption = "Vous pouvez pointer"
        End If

            ' On récupère le contenu des 2e et 3e colonnes dans Txt_Noms
            Me.Txt_Noms.Value = Ligne.Range(1, 2).Value
            Me.Txt_Prénom.Value = Ligne.Range(1, 3).Value
            Me.Txt_ContH.Value = Application.Text(Ligne.Range(1, 4), "[h]:mm")
            
            'On calcule le N° de la semaine
            Me.Txt_NumSem = WorksheetFunction.IsoWeekNum(Now)
                        
            ' On vide la ListBox
            UfPointage.Lst_Pointage.Clear
            
            ' On dénombre les lignes du TS
            NbLigTS = Range("t_Saisie").ListObject.ListRows.Count
            NumLigListBox = -1
            For NumLigTS = 1 To NbLigTS
                If Range("t_Saisie[Code agent]")(NumLigTS).Value = CodeRecherche And Range("t_Saisie[Semaine]")(NumLigTS).Value = WorksheetFunction.IsoWeekNum(Date) Then
                    NumLigListBox = NumLigListBox + 1
                    
                    ' On ajoute une ligne à la ListBox
                    Me.Lst_Pointage.AddItem
                    
                    ' On écrit la date dans la première colonne de la ListBox
                    Me.Lst_Pointage.Column(0, NumLigListBox) = Range("t_Saisie[Date]")(NumLigTS).Text
                    
                    ' On écrit les heures de pointage de la 2e à la 7e colonne de la ListBox
                    For i = 1 To 6
                        Me.Lst_Pointage.Column(i, NumLigListBox) = Range("t_Saisie")(NumLigTS, i + 5).Text
                    Next i
                End If
            Next NumLigTS
            Exit For

        ' Si le code agent n'est pas trouvé
        Else

            Me.Txt_Noms.Value = ""
            Me.Txt_Prénom.Value = ""
            UfPointage.Lst_Pointage.Clear

        End If

    Next Ligne
    
    With Sheets("Tab_Pointage").ListObjects("t_Saisie")
        Trouve = False
            For D = 1 To .ListRows.Count
                If .ListColumns("Code agent").DataBodyRange(D) = Me.Txt_Code And .ListColumns("Date").DataBodyRange(D) = Me.TxB_DateJour Then
            lig = 1
        Trouve = True
            Exit For
                End If
            Next D
            
            If Not Trouve Then Exit Sub
            
            Me.Txt_Point1.Value = Format(.DataBodyRange(D, 6), "hh:mm")
            Me.Txt_Point2.Value = Format(.DataBodyRange(D, 7), "hh:mm")
            Me.Txt_Point3.Value = Format(.DataBodyRange(D, 8), "hh:mm")
            Me.Txt_Point4.Value = Format(.DataBodyRange(D, 9), "hh:mm")
            Me.Txt_Point5.Value = Format(.DataBodyRange(D, 10), "hh:mm")
            Me.Txt_Point6.Value = Format(.DataBodyRange(D, 11), "hh:mm")
    End With

End Sub

Private Sub Txt_Point1_Change()
Call Txt_Code_Change
End Sub
Private Sub Txt_Point2_Change()
Call Txt_Code_Change
End Sub
Private Sub Txt_Point3_Change()
Call Txt_Code_Change
End Sub
Private Sub Txt_Point4_Change()
Call Txt_Code_Change
End Sub
Private Sub Txt_Point5_Change()
Call Txt_Code_Change
End Sub
Private Sub Txt_Point6_Change()
Call Txt_Code_Change
End Sub

TooFatBoy · Hier à 13:37

NONO14 à dit:
A quoi sert ce code dans ton fichier exemple, n'est-il pas un doublon ?

Oui, tu as raison, c'est un doublon. Bien vu.

Remplir_t_Saisie est la macro que j'avais pondue au départ pour remplir la TextBox, dont j'ai ensuite intégré le code directement dans la macro Txt_Code_Change.

NONO14 · Hier à 14:54

TooFatBoy à dit:
Oui, tu as raison, c'est un doublon. Bien vu.

Remplir_t_Saisie est la macro que j'avais pondue au départ pour remplir la TextBox, dont j'ai ensuite intégré le code directement dans la macro Txt_Code_Change.

ChTi160 · Hier à 14:58

Re
Lorsque je lance la macro # 112 , y manque plusieurs Controls dans la Userform "UfPointage"
exemple :

Me.Txt_ContH.Value ,Me.Txt_NumSem Lol

c'est qui qu'a fait ça Lol ?
Jean marie

NONO14 · Hier à 15:00

Là je m'arrache les cheveux pour trouver la fin de mon code.
Rechercher la dernière colonne vide sur la ligne qui correspond au code de l'agent et à la date du jour et y insérer l'heure système au format "hh:mm". Pour les colonnes 4 et 5 je sais faire.
Voici le début de mon code

VB:

Private Sub Cmb_Entrée_Click()
Dim Ctrl As Control
Dim TrouvLig As Boolean, TrouvDerLig As Boolean
Dim LastColumn As Integer

    Set Wsh = Sheets("Tab_Pointage") 'Nom de la feuille
    Set Tbls = Wsh.ListObjects("t_Saisie") 'Nom du TS
    
    If Me.Txt_Code.Value = "" Then  ' Si la TextBox est vide, un message d'alerte dans le Label information
        Me.Lbx_Information.Caption = "Vous devez renseigner votre code"
        Exit Sub
    End If

    DeProtege ("Tab_Pointage")  ' On déprotège la feuille de calcul "Planning"

    With Sheets("Tab_Pointage").ListObjects("t_Saisie")    ' On utilise la feuille et son TS pour les recherches et les saisies

        TrouvLig = False

        For i = 1 To .ListRows.Count     ' Pour chaque ligne du TS on recherche le code agent et la date

AAA = (.ListColumns("Code agent").DataBodyRange(i).Value = Me.Txt_Code)
xxx = (.ListColumns("Code agent").DataBodyRange(i).Value = Me.Txt_Code)
BBB = (Format(Sheets("Tab_Pointage").ListObjects("t_Saisie").ListColumns("Date").DataBodyRange(i).Value2, "dddd dd mmmm aaaa") = Me.TxB_DateJour)
yyy = (.ListColumns("Date").DataBodyRange(i) = Me.TxB_DateJour)

            If .ListColumns("Code agent").DataBodyRange(i).Value = Me.Txt_Code And .ListColumns("Date").DataBodyRange(i) = Me.TxB_DateJour Then
                Ligne = i
                TrouvLig = True
                Exit For
            End If
        Next i

        If Not TrouvLig Then    ' Si on n'a pas trouvé la ligne, on crée une nouvelle ligne
            Ligne = .ListRows.Add.Index
        End If

        ' On écrit les infos dans le TS
        .DataBodyRange(Ligne, 1) = Me.Txt_Code
        .DataBodyRange(Ligne, 2) = Me.Txt_Noms
        .DataBodyRange(Ligne, 3) = Me.Txt_Prénom
        
        'Mettre la suite ici : insérer l'heure système dès la 1ère colonne vide trouvée
        'à partir de la colonne 6
        
        
    End With
    
End Sub

NONO14 · Hier à 15:01

ChTi160 à dit:
Re
Lorsque je lance la macro # 112 , y manque plusieurs Controls dans la Userform "UfPointage"
exemple :

c'est qui qu'a fait ça Lol ?
Jean marie

Je n'ai pas mis le bon fichier oups !
Le voici

ChTi160 · Hier à 15:01

Re
arfffffffffffffffffffff ! Lol
Jean marie

NONO14 · Hier à 15:15

ChTi160 à dit:
Re
arfffffffffffffffffffff ! Lol
Jean marie

Parce que j'ai un fichier d'essai et l'autre lorsque les codes sont finalisés, comme ça je ne risque pas de planter mon application. Pour moi, c'est sécurisant.

ChTi160 · Hier à 15:17

Re
tu fais plein de Sauvegardes , dès que tu avances !
Jean marie

Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système

NONO14

XLDnaute Impliqué

Pièces jointes

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

Pièces jointes

NONO14

XLDnaute Impliqué

Pièces jointes

ChTi160

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Pièces jointes

ChTi160

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

ChTi160

XLDnaute Barbatruc

Discussions similaires