Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

N

NONO14

XLDnaute Impliqué
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
 

Pièces jointes

  • GestPersonnnel (3).xlsm
    477.7 KB · Affichages: 12
Solution
bonjour

on est d'accord que pour répondre à la question posée dans le titre, il suffit de faire

VB: 
with sheets("NomFeuille").listobjects("NomTS")
    .Listcolumns("NomColonne").databodyrange(.listrows.count)=now
end with

avec NomFeuille=nom de la feuille sur laquelle est le TS
NomTS = nom du TS
NomColonne = nom de la colonne du TS dans laquelle mettre la date du jour
Trier par date Trier par votes
N

NONO14

XLDnaute Impliqué
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.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
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
 
Vote positif 0 Vote négatif

ChTi160

XLDnaute Barbatruc
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
 

Pièces jointes

  • Nono14-6.gif
    193.5 KB · Affichages: 6
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
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.
 

Pièces jointes

  • GestPersonnnel (3).xlsm
    513.9 KB · Affichages: 1
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
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
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
300
NONO14
N
N
  • Résolu(e)
Microsoft 365 Supprimer de la liste d'une Combo les données déjà présentes dans une colonne d'un TS
2
Réponses
18
Affichages
522
NONO14
N
N
  • Résolu(e)
Microsoft 365 Remplir une ComboBox à 3 colonnes avec les données d'un TS
4 5 6
Réponses
78
Affichages
1 K
Dudu2
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
215
NONO14
N
N
  • Résolu(e)
Microsoft 365 Modification impossible d'une TextBox
2 3 4
Réponses
56
Affichages
1 K
NONO14
N
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
N
  • Résolu(e)
Microsoft 365 Récupération données ListBox dans TextBox
2 3
Réponses
35
Affichages
566
NONO14
N
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
N
  • Question
Microsoft 365 Séparer NOM et Prénom d'une ListBox dans 2 Textbox
5 6 7
Réponses
98
Affichages
2 K
NONO14
N
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
465
arnoldbrice19
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…