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é
Bonjour TooFatBoy,
Merci beaucoup pour ton travail qui me convient tout à fait. Concernant les boutons "Entrée" et "Sortie", je les ai volontairement rendu utilisable ou pas selon le contenu des Txt_Point. Dans la finalité, si il y a une entrée, il doit obligatoirement y avoir une sortie. Tous pointages sera dès lors impossible temps que cette condition n'est pas remplie. De cette façon, si il y a un "oubli" l'agent devra voir avec le responsable pour modifier l'état des pointages, c'est comme ça que m'ont été présenté les choses. Une manière de limiter les "oublis".
Pour les modifications, l'administrateur passe par le formulaire "Menus". Par contre, là on peut peut-être modifier la façon de faire, en évitant cette procédure lorsque l'agent a tapé son code et qu'il s'aperçoit d'un manque. On devrait pouvoir cliquer sur le bouton "Modifier" et après le mot de passe, pouvoir opérer les modifications sans sortir du formulaire. Qu'en penses-tu ?
Je te réitère ici mes chaleureux remerciements

Ps: Très joli l'UfPointage
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
On pourrait utiliser un truc comme ça par exemple :
VB: 
'Pour accèder à la modif Excel demande un mot de passe
Mdp = Application.InputBox("Mot de passe", "Entrer le mdp")
If Mdp <> "Toto" Then
    MsgBox "Mdp incorrect", vbCritical
Exit Sub
End If

'la suite de la macro

End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
J'ai réussi à faire quelque chose, regarde dans le fichier (avec tes modifs).
Lorsque l'on clique sur le bouton modifier de l'UfPointage, plus besoin de quitter le formulaire.
 

Pièces jointes

  • GestPersonnnel (4).xlsm
    506.1 KB · Affichages: 3
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Ça me semble plus pratique.
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Je viens de DL ton classeur, et il y a des trucs qui me chiffonnent un peu...

- Quand l'admin modifie une heure, ça n'est pas répercuté immédiatement dans la ListBox.

- Quand l'admin a fait une modification, le bouton "Modifier" devient "Disabled", donc pas moyen de faire une autre modif.

- Si l'employé clique sur le bouton "Retour aux menus", il accède au menu de l'admin...
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Bonjour TooFatBoy, bonjour le fil,

1 - Oui j'ai remarqué ça aussi, je vais arranger ce problème
2 - Normalement il ne devrait pas avoir plus d'une modification à faire, mais il est vrai que dans l'absolu ce n'est pas l'idéal.
3 - Oui je sais je n'ai pas mis de code pour l'instant car je navigue entre les deux et j'en avais marre de taper le code à chaque fois, mais il y aura bien un code d'accès.
Merci d'avoir soulevé ces problèmes.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Comment utiliser ce code pour qu'il ne prenne les données de "t_Saisie" qu'à partir de la colonne Date jusqu'à la colonne L. En l'état, il colle toutes les données de la ligne depuis la colonne 1
Merci pour votre aide
VB: 
Sub RempListeBox()

    UfPointage.Lst_Pointage.RowSource = Range("t_Saisie").Address(, , , True)

 End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
ChTi160 à dit:
Bonjour le Fil

je vois que tu es revenu au Rowsource §
il faut surement utiliser un "Resize" de la partie "DataBodyrange" .
Jean marie
Cliquez pour agrandir...
Bonjour ChTi160,
J'espère que tu vas bien, content de te revoir aussi vite.
Merci pour ta réponse. Je vais faire des recherches pour le "Resize".
Le but étant de rapatrier les données du "t_Saisie" à partir de la colonne 5 dans ma ListBox à partir de sa 1ère colonne.
J'ai essayé un truc comme ça, mais ça ne fonctionne pas, alors je vais chercher à faire autrement.
VB: 
Sub RempListBox()
Dim Ws As Worksheet
Dim Tbl As ListObject

    ' Définir la feuille et le tableau structuré
    Set Ws = ThisWorkbook.Sheets("Tab_Pointage")
    Set Tbl = Ws.ListObjects("t_Saisie") ' Nom du tableau structuré

    ' Définir la plage de colonnes de 5 à 10
    UfPointage.Lst_Pointage.RowSource = Ws.Range(Tbl.ListColumns(5).DataBodyRange.Cells(1, 1), Tbl.ListColumns(10).DataBodyRange.Cells(Tbl.ListRows.Count, 1)).Address(, , , True)
 End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Voici le code qui fonctionne. Il n'est pas très joli, il y a certainement mieux à faire, mais il a le mérite de fonctionner.
Code: 
Sub RempListBox()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim Cell As Range
Dim i As Long
Dim j As Long

    ' Définir la feuille et le tableau structuré
    Set Ws = Sheets("Tab_Pointage") 'Nom de la feuille
    Set Tbl = Ws.ListObjects("t_Saisie") ' Nom du tableau structuré

    ' Vider la ListBox
    UfPointage.Lst_Pointage.Clear

    ' Parcourir chaque ligne du tableau structuré et remplir la ListBox
    
    For i = 1 To Tbl.ListRows.Count
        With Tbl.ListRows(i).Range
            
            ' Ajouter une ligne vide à la ListBox
            UfPointage.Lst_Pointage.AddItem
            
            ' Remplir les colonnes de la ListBox avec les données des colonnes 5 à 10 du tableau
            For j = 1 To 6
                UfPointage.Lst_Pointage.List(UfPointage.Lst_Pointage.ListCount - 1, j - 1) = .Cells(1, j + 4).Text
            Next j
        End With
    Next i
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy,
J'ai regardé sur le Net concernant la boîte à outils qui parasite le bon déroulement. Apparemment il y aurait un objet parasite de caché quelque part dans l'UF (Bouton, TextBox ou autres). Je vais donc partir à la recherche du petit fantôme.
Pour le moment je vais m'absenter, je reviendrai en fin de matinée.
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
NONO14 à dit:
Comment utiliser ce code pour qu'il ne prenne les données de "t_Saisie" qu'à partir de la colonne Date jusqu'à la colonne L.
VB: 
Range("t_Saisie").Address(, , , True)
Cliquez pour agrandir...
Je ne sais pas exactement, mais logiquement je commencerai par essayer un truc dans ce genre :
Enrichi (BBcode): 
Range("t_Saisie[[Date]:[L]]").Address(, , , True)

Mais perso, je laisserai le TS complet dans la ListBox, et je mettrai à zéro la largeur des colonnes que je veux ne pas voir.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
J'ai réussi à faire ce code et il fonctionne. Qu'en penses-tu ?
VB: 
Sub RempListBox()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim Cell As Range
Dim i As Long
Dim j As Long

    ' Définir la feuille et le tableau structuré
    Set Ws = Sheets("Tab_Pointage") ' Nom de la feuille
    Set Tbl = Ws.ListObjects("t_Saisie") ' Nom du tableau structuré

    ' Vider la ListBox
    UfPointage.Lst_Pointage.Clear

    ' Parcourir chaque ligne du tableau structuré et remplir la ListBox
    For i = 1 To Tbl.ListRows.Count
        With Tbl.ListRows(i).Range
            ' Ajouter une ligne vide à la ListBox
            UfPointage.Lst_Pointage.AddItem

            ' Remplir les colonnes de la ListBox avec les données des colonnes 5 à 10 du tableau
            For j = 1 To 6
                UfPointage.Lst_Pointage.List(UfPointage.Lst_Pointage.ListCount - 1, j - 1) = .Cells(1, j + 4).Text
            Next j

            ' Ajouter la valeur de la colonne 13 dans la 8ème colonne de la ListBox
            UfPointage.Lst_Pointage.List(UfPointage.Lst_Pointage.ListCount - 1, 7) = .Cells(1, 13).Text
        End With
    Next i
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Je n'ai pas trouvé le parasite, alors le problème persiste
 
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…