Microsoft 365 Modification impossible d'une TextBox

[NONO14]

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

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

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

 

[TooFatBoy]

Ah, d'accord. Donc inutile que je continue de la chercher dans ton dernier classeur en date...

Tschüss

 

[laurent950]

Bonsoir,

C'est ici que cela ne vas pas

With Me.Txt_Code
.Value = CurrentYear & Left(Me.Txt_Nom, 3) & GenerateCode(1, 4)
.SelStart = 100
End With

il faut stocké ce code = d'accord mais pas dans le Me.Txt_Code

La recherche = Set Trouve = .ListColumns(1).Range.Find(Me.Txt_Code, LookAt:=xlWhole)

c'est un code aléatoire, donc c'est un code a créer si il n'existe pas donc Ok par contre il faut chercher le bon code dans une variable tableau, un dictionnaire, une collection, sur excel ect.

 

[TooFatBoy]

Dans ta macro il y a cette ligne :

R.Range(1, 2).Value = UfGestTemps.Txt_Nom.Value

qui doit écrire la première donnée dans le TS.

Mais je ne sais pas pourquoi ça appelle (deux fois consécutivement) la macro Lst_Employ_Click donc forcément ça recopie les données du TS dans les TextBox.

 

[ChTi160]

Bonsoir
une approche non finalisée Lol
il y a comme on l'a je crois indiqué un problème avec l'utilisation de la Propriété "Rowsource"
on ne peut pas utiliser cette méthode et Faire ListBox.clear
ou alimenter la ListBox avec une Boucle !
Regarde la vidéo du résultat obtenu.
bonne nuit
Jean marie

 

[TooFatBoy]

il y a comme on l'a je crois indiqué un problème avec l'utilisation de la Propriété "Rowsource"

Ah ben voilà, c'est sûrement pour ça que la macro est appelée alors qu'on n'a pas cliqué sur la ListBox.

Merci ChTi160

 

[laurent950]

Voila

Public StockageDuBonCodeUtilisateur As String
et
On Error Resume Next
Dim CodeUtilisateur As Variant
Set CodeUtilisateur = ThisWorkbook.Sheets("Liste_agents").ListObjects("t_Noms").ListColumns(2).Range.Find(Me.Txt_Nom, LookAt:=xlWhole)
StockageDuBonCodeUtilisateur = ThisWorkbook.Sheets("Liste_agents").Cells(CodeUtilisateur.Row, CodeUtilisateur.Column - 1).Value
On Error GoTo 0

c'est du bricolage mais cela fonctionne avec cela vous allez pouvoir réussir a débloquer votre code, il suffit dé récrire cette partie proprement et choisir les bonnes variables

'Ces codes ont été créé par vgendron et patricktoulon
Public EnableEvents As Boolean
Dim cl As New cTextBox
Dim Mpage() As P

Private Type P
    Width As Long
    Height As Long
        LeftButton1 As Long
        LeftButton2 As Long
    hCaption As Long
Weight_Cadre As Long
End Type

Public StockageDuBonCodeUtilisateur As String

Private Function resizeMulti()
    With MultiPage1
        .Width = Mpage(.Value).Width
        .Height = Mpage(.Value).Height
        Me.Height = .Height + Mpage(.Value).hCaption + Mpage(.Value).Weight_Cadre * 2 + 25
        Me.Width = .Width + Mpage(.Value).hCaption
    End With
End Function

Private Sub But_AnnulP1_Click()
Me.Txt_Nom.Value = ""
Me.Txt_Nom.SetFocus
Me.Txt_Prénom.Value = ""
Me.Txt_Temps.Value = ""
Me.Txt_Code.Value = ""
End Sub

Private Sub But_Choix_Click()
Unload Me
    UfMenusAdmin.Show (0)
End Sub

Private Sub But_ModifP1_Click()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim I As Long
Dim Found As Boolean

'On définie la feuille de calcul et le TS
    Set Ws = Sheets("Liste_agents")
    Set Tbl = Ws.ListObjects("t_Noms")
   
'On boucle pour trouver la ligne à modifier
    Found = False
       
        For I = 1 To Tbl.ListRows.Count
            If Tbl.DataBodyRange(I, 1).Value = UfGestTemps.Txt_Code.Value Then
                Tbl.DataBodyRange(I, 2).Value = UfGestTemps.Txt_Nom.Value
                Tbl.DataBodyRange(I, 3).Value = UfGestTemps.Txt_Prénom.Value
                Tbl.DataBodyRange(I, 4).Value = UfGestTemps.Txt_Temps.Value
                Found = True
                Exit For
            End If
            Next I
           
                    If Not Found Then
                        MsgBox "Le code agent n'a pas été trouvé", vbExclamation
                    Else
           
                        UpdateListBox
                    End If
End Sub

Private Sub But_QuitP1_Click()
Unload Me
Sheets("Accueil").Activate
End Sub

Private Sub But_ValidP1_Click()
Dim Ctrl As Control
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim NewRow As ListRow

Application.ScreenUpdating = False

'Définir la feuille et le TS
    Set Ws = ThisWorkbook.Sheets("Liste_agents")
    Set Tbl = Ws.ListObjects("t_Noms")

'On déprotège la feuille
    DeProtege ("Liste_agents")
       
'On cherche dans la colonne 1 si le code existe déjà
'Si c'est le cas un message annonce que l'employé(e) existe déjà
        With Tbl
            Set Trouve = .ListColumns(1).Range.Find(StockageDuBonCodeUtilisateur, LookAt:=xlWhole)
                If Not Trouve Is Nothing Then
                    MsgBox "Cet(te) employé(e) existe déjà !"
            Exit Sub
                Else
'On ajoute une nouvelle ligne au tableau
                    Set NewRow = Tbl.ListRows.Add
'On transfère les donnée vers le TS
                        With NewRow
                            .Range(1, 1) = Me.Txt_Code.Value 'Le code dans la 1ère colonne
                            .Range(1, 2) = Me.Txt_Nom.Value 'Le NOM dans la 2ème colonne
                            .Range(1, 3) = Me.Txt_Prénom.Value 'Le Prénom dans la 3ème colonne
                            .Range(1, 4) = Me.Txt_Temps.Value 'Le temps de travail dans la 4ème colonne
                        End With
       
 'Dans la feuille les colonnes sont en largeur automatique
        Sheets("Liste_agents").Columns.AutoFit
   
'On reprotège la feuille
    Protege ("Liste_agents")
   
'On efface les données se trouvant dans les TextBox du formulaire
    For Each Ctrl In Me.MultiPage1.Pages(0).Controls
        Select Case TypeName(Ctrl)
            Case "TextBox"
                Ctrl.Value = ""
        End Select
    Next Ctrl
   
'La TextBox Txt_Nom prend le focus
    Me.Txt_Nom.SetFocus
End If
End With
End Sub

Private Sub Cmb_QuitP2_Click()
Unload Me
End Sub

Private Sub Cmb_QuitP3_Click()
Unload Me
End Sub

Private Sub Lst_Employ_Click()
Dim TimeValue As Double
       
        TimeValue = Me.Lst_Employ.List(Me.Lst_Employ.ListIndex, 3)

     If Me.Lst_Employ.ListIndex <> -1 Then
'On copie les données de la ligne dans les TextBox
    Me.Txt_Nom.Value = Me.Lst_Employ.List(Me.Lst_Employ.ListIndex, 1)
    Me.Txt_Prénom.Value = Me.Lst_Employ.List(Me.Lst_Employ.ListIndex, 2)
    Me.Txt_Code.Value = Me.Lst_Employ.List(Me.Lst_Employ.ListIndex, 0)
    Me.Txt_Temps.Text = Application.Text(TimeValue, "[h]:mm")
    End If

End Sub

Private Sub UpdateListBox()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim I As Long, J As Long

'On définie la feuille de calcul et le TS
    Set Ws = Sheets("Liste_agents")
    Set Tbl = Ws.ListObjects("t_Noms")
   
'On vide la ListBox
    Me.Lst_Employ.Clear
   
'On ajoute les données du TS à la ListBox
    For I = 1 To Tbl.ListRows.Count
    Me.Lst_Employ.AddItem
        For J = 1 To 4
            Me.Lst_Employ.List(I = 1, J - 1) = Tbl.DataBodyRange(I, J).Value
        Next J
    Next I
End Sub

Private Sub MultiPage1_Change()
   
    With Me.MultiPage1.Pages(0)
        If EnableEvents Then resizeMulti
    End With
   
End Sub

Private Sub Txt_Code_Change()
If Me.Txt_Nom.Value = "" Then
    Me.Txt_Code.Value = ""
End If
End Sub

Private Sub Txt_Nom_Change()
'Validation de la saisie du NOM
    Me.Txt_Nom.Text = Replace(UCase(Me.Txt_Nom), Chr(32), Chr(160))
End Sub

Private Sub Txt_Nom_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim CurrentYear As String
Application.ScreenUpdating = False

    CurrentYear = Right(Year(Date), 2)
   
    If Me.Txt_Code.Value <> "" Then Exit Sub
   
        With Me.Txt_Code
        .Value = CurrentYear & Left(Me.Txt_Nom, 3) & GenerateCode(1, 4)
        .SelStart = 100
        End With
       
        On Error Resume Next
        Dim CodeUtilisateur As Variant
        Set CodeUtilisateur = ThisWorkbook.Sheets("Liste_agents").ListObjects("t_Noms").ListColumns(2).Range.Find(Me.Txt_Nom, LookAt:=xlWhole)
        StockageDuBonCodeUtilisateur = ThisWorkbook.Sheets("Liste_agents").Cells(CodeUtilisateur.Row, CodeUtilisateur.Column - 1).Value
        On Error GoTo 0
End Sub

Private Sub Txt_Prénom_Change()
'Validation de la saisie du Prénom
    Me.Txt_Prénom.Text = Replace(WorksheetFunction.Proper(Me.Txt_Prénom.Value), Chr(32), Chr(160))
End Sub

Private Sub Txt_Temps_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim StrValue As String

    StrValue = Me.Txt_Temps.Text
   
'Permet uniquement les chiffres et les deux points
    If Not (KeyAscii >= 48 And KeyAscii <= 57) And KeyAscii <> 58 Then
        KeyAscii = 0
    End If
   
'Ajoute automatiquement les deux points après les heures
    If Len(StrValue) = 2 And KeyAscii <> 0 Then
        Me.Txt_Temps.Text = StrValue & ":"
        Me.Txt_Temps.SelStart = Len(Me.Txt_Temps.Text)
    End If
End Sub

Private Sub UserForm_Initialize()

'On enlève la croix de fermeture du formulaire
    SansCroix Me

'Initialisation de la date du début de la semaine en partant du lundi
    If Weekday(Now, 2) <> 1 Then
        Me.Tbx_DebSem = Format(Now - Weekday(Now + 2) + 1, "dd/mm/yyyy")
    Else
        Me.Tbx_DebSem = Format(Now, "dd/mm/yyyy")
    End If
   
    Me.Tbx_NumSem = WorksheetFunction.IsoWeekNum(Now)
    Me.Tbx_FinSem = CDate(Me.Tbx_DebSem) + 6
   
'On écrit "Retour Menus" sur 2 lignes pour le bouton But_Choix
    Me.But_Choix.Caption = "Retour" & vbCrLf & "Menus"
   
'Préparation des éléments pour le resize
    For Each pag In MultiPage1.Pages: ic = ic & CStr(pag.Caption): Next: minlarge = Len(ic) * 7
        For Each pag In MultiPage1.Pages
            ReDim Preserve Mpage(0 To pag.Index)
                WW = 0: HH = 0
               
    For Each Ctrl In pag.Controls
        If Ctrl.Left + Ctrl.Width + 20 > WW Then WW = Ctrl.Left + Ctrl.Width + 20: If WW < minlarge Then WW = minlarge
        If Ctrl.top + Ctrl.Height + 50 > HH Then HH = Ctrl.top + Ctrl.Height + 50
    Next Ctrl
   
    Mpage(pag.Index).Width = WW: Mpage(pag.Index).Height = HH
        Mpage(pag.Index).hCaption = Me.Height - Me.InsideHeight
            Mpage(pag.Index).Weight_Cadre = Me.Width - Me.InsideWidth
    Next pag
   
    EnableEvents = True
   
resizeMulti
End Sub

Function GenerateCode(Optional NbChar& = 0, Optional NbNum& = 0, Optional Melange = False)
Dim Y&, C&, L, X&, Temp, I&

'Si la TextBox Txt_Nom est vide alors la procédure ne se déclanche pas.
    If Me.Txt_Nom.Value = "" Then Exit Function

'On défini le nombre de caractère pour chaque chiffre et lettre
    If NbChar = 0 Then NbChar = 1 + (Round(Rnd * 6))
    If NbNul = 0 Then NbNum = 1 + (Round(Rnd * 3))
   
    Set Dico = CreateObject("Scripting.Dictionary")
    StrLettres = Split(StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZ", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
   
    Do While Dico.Count < NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        Dico(StrChiffres(Y)) = ""
    Loop
   
    Do While Dico.Count < NbChar + NbNum
        Y = Round(Rnd * UBound(StrLettres))
        Dico(StrLettres(Y)) = ""
    Loop
   
    L = Dico.Keys
    Randomize
   
        If Melange Then
            For I = LBound(L) To UBound(L)
                X = Round(UBound(L) * Rnd)
                    Temp = L(I): L(I) = L(X): L(X) = Temp
            Next
        End If
       
        GenerateCode = Join(L, "")
   
End Function

 

[ChTi160]

Re
Bonsoir Laurent
je pense que dans la procédure "But_ModifP1_Click()" le fait de faire appel au UfGestTemps
déclenche la dernière procédure soit Le Click sur ListBox
je regarde demain plus avant .
Jean marie

 

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

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.

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.

If MaJ_en_cours Then Exit Sub

 

[laurent950]

Bonjour @ChTi160

c'est le modéle objet qui est pas très bien construit, vu le code VBA avec module de classe etc. c'était pas si compliqué a débugué

le Texte box de l'ID de l'employé ce remplis avec un code aléatoire qui est prévu pour préremplir un nouvel employé si celui ci n'existe pas

ensuite il recherche dans le tableau structuré via le code ID de cette employé si il existe trés bien mais comme il cherche avec la text boxe (qui elle a était remplis avec le code éléatoire) et bien il ne trouvera jamais le le code ID de l'employé car lui n'existe pas (car bien sur c'est un code ID pour la création d'un futur utilisateur) et donc il faut récupérer est stocké le bon code ID utilisateur existant dans le la colonne 1 de ce tableau structuré en rapport avec le nom de cette ID utilisateur qui lui existe bien

alors le test fonctionne ensuite
si cela existe = cela remplis le bon code
et si cela n'existe pas alors ont créer le nouvel utilisateur avec l'id créer aléatoirement

c'est lidée

 

[ChTi160]

Re
ce que j'avais mis Lol

Private Sub Lst_Employ_Click()
Dim TimeValue As Double
 If Ok_Change = False Then Exit Sub
 With UfGestTemps
  With .Lst_Employ
        TimeValue = .List(.ListIndex, 3)
     If .ListIndex <> -1 Then
'On copie les données de la ligne dans les TextBox
    Me.Txt_Nom.Value = .List(.ListIndex, 1)
    Me.Txt_Prénom.Value = .List(.ListIndex, 2)
    Me.Txt_Code.Value = .List(.ListIndex, 0)
    Me.Txt_Temps.Text = Application.Text(TimeValue, "[h]:mm")
    End If
 End With
End With
End Sub

Private Sub But_ModifP1_Click()
Dim Ws As Worksheet
Dim Tbl As ListObject
Dim I As Long
Dim Found As Boolean

'On définie la feuille de calcul et le TS
    Set Ws = Sheets("Liste_agents")
    Set Tbl = Ws.ListObjects("t_Noms")
    
'On boucle pour trouver la ligne à modifier
    Found = False
    With UfGestTemps
        For I = 1 To Tbl.ListRows.Count
            If Tbl.DataBodyRange(I, 1).Value = .Txt_Code.Value Then
            Ok_Change = False 'Ici
                Tbl.DataBodyRange(I, 2).Value = .Txt_Nom.Value
                Tbl.DataBodyRange(I, 3).Value = .Txt_Prénom.Value
                Tbl.DataBodyRange(I, 4).Value = .Txt_Temps.Value
                Found = True
                Exit For
            End If
            Next I
    End With
        Ok_Change = True 'Ici
                    If Not Found Then
                        MsgBox "Le code agent n'a pas été trouvé", vbExclamation
                    Else
            
                      RempliListeBox 'ici
                      
                    End If
End Sub

Bon j'arrête Lol
Jea marie

 

[TooFatBoy]

il y a comme on l'a je crois indiqué un problème avec l'utilisation de la Propriété "Rowsource"
on ne peut pas utiliser cette méthode et Faire ListBox.clear
ou alimenter la ListBox avec une Boucle !

Le RowSource est justement là pour éviter d'avoir à écrire une macro avec une boucle., et du coup Il n'y a aucune raison de faire un Clear.

Ceci dit, les deux méthodes existent donc on peut bien sur utiliser celle que l'on veut :
- soit renseigner le paramètre RowSource,
- soit écrire une macro avec une boucle pour remplir la ListBox, et écrire une macro pour mettre à jour la ListBox en la vidant puis en passant par une boucle pour la recharger.
C'est au choix de chacun.

 

[laurent950]

Bonsoir @TooFatBoy

je pense que cela ne peux pas fonctionner, si dans une entreprise il y a 5 nom de personnes avec le même Nom = Durand (comment le système conçu va rechercher l'ID correspondant au bon Durand ?)

 

[TooFatBoy]

je pense que cela ne peux pas fonctionner, si dans une entreprise il y a 5 nom de personnes avec le même Nom = Durand (comment le système conçu va rechercher l'ID correspondant au bon Durand ?)

Je ne comprends pas exactement le problème que tu soulèves, donc je ne saurais te dire si ça fonctionnerait ou pas (mais actuellement je ne vois pas pourquoi ça ne marcherait pas) dans le cas que tu décris.
Il est effectivement possible que tu aies raison. Bon, ici dans le cas de Nono14, heureusement ça fonctionne.


[edit]

comment le système conçu va rechercher l'ID correspondant au bon Durand ?

Je crois que j'ai compris la question.
L'ID étant dans la ListBox, il faut le mémoriser dans une TextBox cachée ou dans une variable programme.
Ainsi pas moyen de se tromper de personne. Du moins... je pense.
[/edit]

 

[TooFatBoy]

Je crois que NONO14 est comme moi : nous sommes loin d'avoir votre maîtrise d'Excel, PQ, VBA, etc. et qu'il faut donc pondre un code le plus simple possible pour que NONO14 ait le plus de chances possibles d'effectuer tout seul la maintenance du code de son projet.

Donc, pour moi, exit les modules de classe pour empêcher de cocher plusieurs "cases à cocher" à la fois, ou pour permettre de cocher plusieurs "boutons radio" à la fois, ou des boucles pour remplir une ListBox, etc.


Je peux bien évidemment me tromper, mais c'est comme ça que je vois actuellement les choses sur son projet.
Et c'est pour ça que j'ai essayé de lui pondre un truc simple à modifier (juste 4 lignes à ajouter), et qui semble fonctionner.

Il a deux propositions. Il prendra bien la proposition qu'il préfèrera.


Bonne nuit à tous

 

[NONO14]

Bonsoir
une approche non finalisée Lol
il y a comme on l'a je crois indiqué un problème avec l'utilisation de la Propriété "Rowsource"
on ne peut pas utiliser cette méthode et Faire ListBox.clear
ou alimenter la ListBox avec une Boucle !
Regarde la vidéo du résultat obtenu.
bonne nuit
Jean marie

Bonjour ChTi160
C'est exactement ce que j'attends, que l'on puisse modifier les 3 TextBox, Nom, Prénom et temps.
Par contre, je me suis rendu compte d'une chose, par exemple si j'ai écrit AUCHON le code agent sera donc 24AUC000 mais si son Nom est CAUCHON donc 24CAU000, le code lui ne sera pas modifié ou alors permettre également sa modification et écraser l'ancien dans le TS, ou alors supprimer les 3 caractère du code et ne mettre que des chiffres. Mais là ça ne dépend pas de moi mais de la tête pensante....