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
vgendron
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
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
NONO14 à dit:
Voici la dernière mouture du fichier.
Cliquez pour agrandir...
Quelques petits soucys.

- Quand je clique sur la ListBox du "Formulaire de pointage", j'ai la boîte à outils de VBE qui apparaît ! 😲

- Il y a une macro Lst_Pointage_Click mais la ListBox en question est en Enabled=False, donc ladite macro n'est jamais appelée.

- Si je passe ladite ListBox en Enabled=True, quand je clique dedans, la TextBox sous "Nous sommes le :" prend la date de la ligne cliquée.

- La macro Lst_Pointage_Click commence par :
VB: 
If Maj_En_Cours Then Exit Sub
Je ne vois pas bien à quoi ça sert. :(
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
J'ai aussi eu ce problème (résolu sur un des fichier d'ailleurs)
Je vais être plus ou moins indisponible pendant quelques jours(opération de la main droite demain matin) j'suis droitier lol
Je verrais donc ce que je serai capable de faire lol
Bonne nuit
Jean marie
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
Quelques petits soucys.

- Quand je clique sur la ListBox du "Formulaire de pointage", j'ai la boîte à outils de VBE qui apparaît ! 😲

- Il y a une macro Lst_Pointage_Click mais la ListBox en question est en Enabled=False, donc ladite macro n'est jamais appelée.

- Si je passe ladite ListBox en Enabled=True, quand je clique dedans, la TextBox sous "Nous sommes le :" prend la date de la ligne cliquée.

- La macro Lst_Pointage_Click commence par :
VB: 
If Maj_En_Cours Then Exit Sub
Je ne vois pas bien à quoi ça sert. :(
Cliquez pour agrandir...
Elle n'est appelée qu'en mode modifications, pour Maj_en_Cours, ce code a été mis lors d'une modification d'un participant, je vais essayer de retrouver la discussion.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
La macro actuelle est celle-ci :
VB: 
Private Sub Lst_Pointage_Click()
'
Dim Col As Byte

    If Maj_En_Cours Then Exit Sub
    On Error GoTo Suite

    ' Vérifie si une ligne a été sélectionnée dans  la ListBox
    With Me.Lst_Pointage
        If .ListIndex = -1 Then
            MsgBox "Aucun élément sélectionné dans la ListBox."
        Else
            ' Boucle sur les colonnes 1 à 6 de la ListBox
            For Col = 1 To 6
                ' Récupère la valeur dans la colonne et la formate comme une heure
                Me.Controls("Txt_Point" & Col).Text = Application.Text(Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, Col), "hh:mm")
                Me.Controls("Txb_DateJour").Text = Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, 0)
            Next Col
        End If
    End With

    Exit Sub

Suite:
    MsgBox "Erreur lors de la récupération des données. Veuillez vérifier les valeurs.", vbExclamation

End Sub

Pour moi :
- le test sur la variable Maj_En_Cours ne sert à rien,
- je ne crois pas qu'il soit réellement possible qu'on clique sur la ListBox et que l'index soit égal à -1,
- je ne crois pas qu'il faille mettre à jour la date du "Nous sommes le :" avec la date de la ligne cliquée,
- si on veut absolument mettre à jour la date du "Nous sommes le :" avec la date de la ligne cliquée, je pense qu'il est inutile de le faire six fois.

Du coup je proposerais ceci :
VB: 
Private Sub Lst_Pointage_Click()
'
Dim Col As Byte

    On Error GoTo Suite

    With Me.Lst_Pointage
            ' Boucle sur les colonnes 1 à 6 de la ListBox
            For Col = 1 To 6
                ' Récupère la valeur dans la colonne et la formate comme une heure
                Me.Controls("Txt_Point" & Col).Text = Application.Text(Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, Col), "hh:mm")
            Next Col
            Me.Controls("Txb_DateJour").Text = Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, 0)
        End If
    End With

    Exit Sub

Suite:
    MsgBox "Erreur lors de la récupération des données. Veuillez vérifier les valeurs.", vbExclamation

End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
TooFatBoy à dit:
La macro actuelle est celle-ci :
VB: 
Private Sub Lst_Pointage_Click()
'
Dim Col As Byte

    If Maj_En_Cours Then Exit Sub
    On Error GoTo Suite

    ' Vérifie si une ligne a été sélectionnée dans  la ListBox
    With Me.Lst_Pointage
        If .ListIndex = -1 Then
            MsgBox "Aucun élément sélectionné dans la ListBox."
        Else
            ' Boucle sur les colonnes 1 à 6 de la ListBox
            For Col = 1 To 6
                ' Récupère la valeur dans la colonne et la formate comme une heure
                Me.Controls("Txt_Point" & Col).Text = Application.Text(Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, Col), "hh:mm")
                Me.Controls("Txb_DateJour").Text = Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, 0)
            Next Col
        End If
    End With

    Exit Sub

Suite:
    MsgBox "Erreur lors de la récupération des données. Veuillez vérifier les valeurs.", vbExclamation

End Sub

Pour moi :
- le test sur la variable Maj_En_Cours ne sert à rien,
- je ne crois pas qu'il soit réellement possible qu'on clique sur la ListBox et que l'index soit égal à -1,
- je ne crois pas qu'il faille mettre à jour la date du "Nous sommes le :" avec la date de la ligne cliquée,
- si on veut absolument mettre à jour la date du "Nous sommes le :" avec la date de la ligne cliquée, je pense qu'il est inutile de le faire six fois.

Du coup je proposerais ceci :
VB: 
Private Sub Lst_Pointage_Click()
'
Dim Col As Byte

    On Error GoTo Suite

    ' Vérifie si une ligne a été sélectionnée dans  la ListBox
    With Me.Lst_Pointage
            ' Boucle sur les colonnes 1 à 6 de la ListBox
            For Col = 1 To 6
                ' Récupère la valeur dans la colonne et la formate comme une heure
                Me.Controls("Txt_Point" & Col).Text = Application.Text(Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, Col), "hh:mm")
            Next Col
            Me.Controls("Txb_DateJour").Text = Me.Lst_Pointage.List(Me.Lst_Pointage.ListIndex, 0)
        End If
    End With

    Exit Sub

Suite:
    MsgBox "Erreur lors de la récupération des données. Veuillez vérifier les valeurs.", vbExclamatu as plus tion

End Sub
Cliquez pour agrandir...
Merci TooFatBoy, je testerai cela demain matin. Étant donné que tu as plus d'expérience que moi en vba, tu as certainement raison.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
- J'ai corrigé quelques macros.
- J'ai un peu modifié le look du UserForm UfPointage.
- J'ai complètement refait la macro Txt_Code_Change qui faisait un peu beaucoup n'importe quoi... ;)
- J'ai n'ai pas touché au code pour l'état des boutons "Entrée" et "Sortie", donc ça fait toujours n'importe quoi.

Remarque : je suis parti du dernier fichier que tu as posté (16/10/2024 à 18:27), donc il y a toutes tes dernières modifs dedans, plus les miennes.
C'est pourquoi, si tu valides mes modifs, je te conseillerais de repartir de ce fichier.


Voici donc la proposition en pièce jointe.
 

Pièces jointes

  • GestPersonnnel (3) ( Nono14 - 2024-10-16_18-27 ) (TFB-002).xlsm
    519.8 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif

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

Membres actuellement en ligne

7 membres et 62 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 096
Messages
2 116 184
Membres
112 679
dernier inscrit
Yupanki