Microsoft 365 Modification impossible d'une TextBox

N

NONO14

XLDnaute Impliqué
Bonjour,
J'ai mis en place ces 2 codes qui permettent de la rapatrier les données d'une ListBox dans des TextBox après un clic sur une ligne et ensuite, après modification et en appuyant sur le bouton "Modifier" de remplacer les données existantes dans le TS (t_Noms) de la feuille "List_agents".
Hors, dès que je modifie une TextBox autre que le Nom, la donnée revient systématiquement après tabulation automatique à celle de la ListBox sans la modifier.
Pouvez-vous m'éclairer s'il vous plaît ? Je ne comprends pas.
Merci par avance

Code lorsque l'on clique sur une ligne de la ListBox
VB: 
Private Sub Lst_Employ_Click()
'Vérifie si une ligne a été sélectionné
With Me
 With .Lst_Employ
    If .ListIndex <> -1 Then
'On récupère les valeurs de la ligne sélectionnée dans les TextBox
         Me.Txt_Nom.Value = .List(.ListIndex, 1)
         Me.Txt_Code.Value = .List(.ListIndex, 0)
         Me.Txt_Prénom.Value = .List(.ListIndex, 2)
         Me.Txt_Temps.Text = Application.Text(.List(.ListIndex, 3), "[h]:mm")
    End If
  End With
End With
End Sub

Module pour transférer les données modifiées vers le TS
Code: 
Sub RemplacerTableau()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim Cell As Range
Dim CodRec As String

'On définie la feuille de calcul
    Set Ws = Sheets("Liste_agents")
    
'On définie le TS
    Set Tbl = Ws.ListObjects("t_Noms")
    
'On définie le code à rechercher
    CodRec = UfGestTemps.Txt_Code.Value

'On recherche le code dans la 1ère colonne du TS
    Set Cell = Tbl.ListColumns(1).DataBodyRange.Find(What:=CodRec, LookIn:=xlValues, LookAt:=xlWhole)

'Si le code est trouvé, on remplace les données de la ligne
    If Not Cell Is Nothing Then
        Cell.Offset(0, 1).Value = UfGestTemps.Txt_Nom.Value 'On remplace la valeur de la colonne 2
        Cell.Offset(0, 2).Value = UfGestTemps.Txt_Prénom.Value 'On remplace la valeur de la colonne 3
        Cell.Offset(0, 3).Value = UfGestTemps.Txt_Temps.Value 'On remplace la valeur de la colonne 4
    Else
        MsgBox "Code non trouvé"
    End If
End Sub
 

Pièces jointes

  • GestPersonnnel (3).xlsm
    498 KB · Affichages: 5
Solution
TooFatBoy
Une proposition modifiant le moins possible de choses (seulement 4 lignes de code à ajouter) :

- Ajouter une variable booléenne ayant pour portée le classeur.
VB: 
Dim MaJ_en_cours As Boolean

- Mettre à True ladite variable au début de la macro But_ModifP1_Click et la remettre à False à la fin.
VB: 
Private Sub But_ModifP1_Click()
'
    MaJ_en_cours = True
    RemplacerTableau
    MaJ_en_cours = False

End Sub

- Ajouter un test sur la valeur de ladite variable au début de la macro Lst_Employ_Click.
VB: 
If MaJ_en_cours Then Exit Sub
Trier par date Trier par votes
wDog66

wDog66

XLDnaute Occasionnel
Bonjour,
Perso, je ne vois pas comment cela fonctionne 🤔
Mais avec le module de classe et les évènements dans l'USF je ne suis pas étonné qu'il y est des interactions non souhaité
Il faudra vous armer de patience et mettre un point d'arrêt F9 là où il faut pour visualiser le déroulement du code avec F8
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonjour

Code: 
Private Sub Lst_Employ_Click()
    On Error GoTo ErrorHandler
    
    'Vérifie si une ligne a été sélectionnée dans la ListBox
    With Me.Lst_Employ
        If .ListIndex <> -1 Then
            'On récupère les valeurs de la ligne sélectionnée dans les TextBox
            Me.Txt_Nom.Value = .List(.ListIndex, 1)
            Me.Txt_Code.Value = .List(.ListIndex, 0)
            Me.Txt_Prénom.Value = .List(.ListIndex, 2)
            Me.Txt_Temps.Text = Application.Text(.List(.ListIndex, 3), "[h]:mm")
        End If
    End With
    
    Exit Sub

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

Code: 
Sub RemplacerTableau()
    Dim Ws As Worksheet
    Dim Tbl As ListObject
    Dim Cell As Range
    Dim CodRec As String

    'On définit la feuille de calcul
    Set Ws = Sheets("Liste_agents")
    
    'On définit le tableau structuré (TS)
    Set Tbl = Ws.ListObjects("t_Noms")
    
    'On définit le code à rechercher dans la première colonne
    CodRec = UfGestTemps.Txt_Code.Value
    
    'On recherche le code dans la première colonne du tableau structuré
    Set Cell = Tbl.ListColumns(1).DataBodyRange.Find(What:=CodRec, LookIn:=xlValues, LookAt:=xlWhole)

    'Si le code est trouvé, on remplace les données de la ligne
    If Not Cell Is Nothing Then
        Ws.Cells(Cell.Row, 2).Value = UfGestTemps.Txt_Nom.Value   'On remplace la valeur de la colonne 2
        Ws.Cells(Cell.Row, 3).Value = UfGestTemps.Txt_Prénom.Value 'On remplace la valeur de la colonne 3
        Ws.Cells(Cell.Row, 4).Value = UfGestTemps.Txt_Temps.Value  'On remplace la valeur de la colonne 4
    Else
        MsgBox "Code non trouvé", vbExclamation
    End If
End Sub
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
laurent950 à dit:
Bonjour

Code: 
Private Sub Lst_Employ_Click()
    On Error GoTo ErrorHandler
   
    'Vérifie si une ligne a été sélectionnée dans la ListBox
    With Me.Lst_Employ
        If .ListIndex <> -1 Then
            'On récupère les valeurs de la ligne sélectionnée dans les TextBox
            Me.Txt_Nom.Value = .List(.ListIndex, 1)
            Me.Txt_Code.Value = .List(.ListIndex, 0)
            Me.Txt_Prénom.Value = .List(.ListIndex, 2)
            Me.Txt_Temps.Text = Application.Text(.List(.ListIndex, 3), "[h]:mm")
        End If
    End With
   
    Exit Sub

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

Code: 
Sub RemplacerTableau()
    Dim Ws As Worksheet
    Dim Tbl As ListObject
    Dim Cell As Range
    Dim CodRec As String

    'On définit la feuille de calcul
    Set Ws = Sheets("Liste_agents")
   
    'On définit le tableau structuré (TS)
    Set Tbl = Ws.ListObjects("t_Noms")
   
    'On définit le code à rechercher dans la première colonne
    CodRec = UfGestTemps.Txt_Code.Value
   
    'On recherche le code dans la première colonne du tableau structuré
    Set Cell = Tbl.ListColumns(1).DataBodyRange.Find(What:=CodRec, LookIn:=xlValues, LookAt:=xlWhole)

    'Si le code est trouvé, on remplace les données de la ligne
    If Not Cell Is Nothing Then
        Ws.Cells(Cell.Row, 2).Value = UfGestTemps.Txt_Nom.Value   'On remplace la valeur de la colonne 2
        Ws.Cells(Cell.Row, 3).Value = UfGestTemps.Txt_Prénom.Value 'On remplace la valeur de la colonne 3
        Ws.Cells(Cell.Row, 4).Value = UfGestTemps.Txt_Temps.Value  'On remplace la valeur de la colonne 4
    Else
        MsgBox "Code non trouvé", vbExclamation
    End If
End Sub
Cliquez pour agrandir...
Bonjour laurent950,
Merci pour votre code, mais j'ai toujours le même problème. Je ne peux que modifier le Nom et pas le reste.
Je cherche de mon côté également.
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Passer par les propriétés du tableau structuré genre
VB: 
Tbl.ListColumns(2).DataBodyRange.cells(cell.row)=UfGestTemps.Txt_Nom.Value
Non testé lol
Ou passer par un tableau temporaire
Sur lequel on boucle pour chercher le CodeAgent etc etc
Depuis mon téléphone.
Jean marie
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Je n'ai pas réussi à trouver, dès que je modifie le Prénom ou le temps de travail, les données tournent en boucle, elles reviennent à la 1ère saisie sans avoir enregistré les modifications. L'enregistrement se fait à l'aide du bouton "Modifier", sur le même principe qu'un bouton "Valider".
Je vais continuer à chercher, peut-être vais-je avoir une petite lumière qui va s'allumer...
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Impliqué
Voici le code pour remplacer les données dans le TS (dans un module)
VB: 
Sub RemplacerTableau()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim R As ListRow
Dim Found As Boolean

    Set Ws = Sheets("Liste_agents") 'On identifie la feuille de calcul
    Set Tbl = Ws.ListObjects("t_Noms") 'On identifie le TS
   
    Found = False
   
    For Each R In Tbl.ListRows
        If R.Range(1, 1).Value = UfGestTemps.Txt_Code.Value Then 'On recherche le code agent dans le TS
            R.Range(1, 2).Value = UfGestTemps.Txt_Nom.Value 'Si on le trouve, on recopie les données en 2ème colonne du TS
            R.Range(1, 3).Value = UfGestTemps.Txt_Prénom.Value 'Puis le Prénom en 3ème
            R.Range(1, 4).Value = UfGestTemps.Txt_Temps.Value 'Et le temps en 4ème
           
            Found = True
    Exit For
        End If
    Next R
   
    If Not Found Then
        MsgBox "Code agent non trouvé", vbExclamation 'Si le code n'est pas trouvé un message
    End If
End Sub

et celui pour charger les TextBox après un clic sur une ligne de la ListBox
Code: 
Private Sub Lst_Employ_Click()
    On Error GoTo ErrorHandler
 
    'Vérifie si une ligne a été sélectionnée dans la ListBox
    With Me.Lst_Employ
        If .ListIndex <> -1 Then
            'On récupère les valeurs de la ligne sélectionnée dans les TextBox
            Me.Txt_Nom.Value = .List(.ListIndex, 1)
            Me.Txt_Code.Value = .List(.ListIndex, 0)
            Me.Txt_Prénom.Value = .List(.ListIndex, 2)
            Me.Txt_Temps.Text = Application.Text(.List(.ListIndex, 3), "[h]:mm")
        End If
    End With
 
    Exit Sub

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

Pièces jointes

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

Discussions similaires

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
536
NONO14
N
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
199
NONO14
N
N
  • Résolu(e)
Microsoft 365 Récupération données ListBox dans TextBox
2 3
Réponses
35
Affichages
271
NONO14
N
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
106
NONO14
N
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
885
Banbara
B
N
  • Question
Microsoft 365 Séparer NOM et Prénom d'une ListBox dans 2 Textbox
5 6 7
Réponses
100
Affichages
1 K
NONO14
N
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
417
AtTheOne
AtTheOne
M
  • Question
XL 2010 Demande de quantité d'un produit dans un magasin spécifique selon la date la plus ancienne
2
Réponses
21
Affichages
1 K
Mody200
M
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
341
crocrocro
C
A
  • Question
XL 2010 Forcer le focus a rester dans un Textbox apres validation
Réponses
11
Affichages
558
aurelio.ewane
A

Membres actuellement en ligne

4 membres et 86 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
314 190
Messages
2 107 001
Membres
109 735
dernier inscrit
Mounskad