Microsoft 365 Modification impossible d'une TextBox

NONO14 · 10 Octobre 2024

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

TooFatBoy · 10 Octobre 2024

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

NONO14 · 11 Octobre 2024

laurent950 à dit:

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

VB:

'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

Bonjour laurent950
Merci pour votre aide, mais là vous m'avez perdu . Que dois-je modifier et où ?
Je ne suis pas un pro du Vba et je suis loin de tout comprendre de ses subtilités.

NONO14 · 11 Octobre 2024

TooFatBoy à dit:
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

Bonjour TooFatBoy
Je regarde le fichier et je reviens. Merci par avance

NONO14 · 11 Octobre 2024

laurent950 à dit:
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

Le code aléatoire, à cette étape, est déjà dans le TS, il existe donc, on le rappelle lors de la modification et on s'en sert pour retrouver la bonne ligne pour enregistrer les nouvelles données modifiées. C'est comme ça que je vois les choses, mais peut-être ai-je tort.

NONO14 · 11 Octobre 2024

laurent950 à dit:
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 ?)

D'où l'importance du code agent qui lui est unique.

NONO14 · 11 Octobre 2024

TooFatBoy à dit:
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

TooFatBoy a raison. Il faut que je puisse maintenir l'application par la suite. Je comprendrai plus facilement des codes simples, bien indentés (certains comprendront). Pour le moment c'est un peu un brouillon, mais je vais arranger tout ça quand l'application sera fonctionnelle ou la partie sur laquelle je travaille terminée. Enfin, vous m'avez compris, je vais passer un coup de balai et ranger tout ça.

NONO14 · 11 Octobre 2024

TooFatBoy à dit:
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

J'ai testé ton fichier et ça fonctionne comme je le souhaitais. Merci mille fois.
Il va falloir trouver une solution pour le code agent en cas de modification du Nom. Mais ça je m'en occupe en interne. Enlever les 3 premières lettres du Nom me paraît être la bonne solution.
J'ai également remarqué que tu avais modifié la page "Accueil" en modifiant la formule, tu as été plus rapide que moi sur le coup

NONO14 · 11 Octobre 2024

TooFatBoy à dit:
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

Les "cases à cocher" sont bien les CheckBox et les "boutons radio" les OptionButton ?

NONO14 · 11 Octobre 2024

NONO14 à dit:
Les "cases à cocher" sont bien les CheckBox et les "boutons radio" les OptionButton ?

C'est bon j'ai ma réponse.

NONO14 · 11 Octobre 2024

NONO14 à dit:
J'ai testé ton fichier et ça fonctionne comme je le souhaitais. Merci mille fois.
Il va falloir trouver une solution pour le code agent en cas de modification du Nom. Mais ça je m'en occupe en interne. Enlever les 3 premières lettres du Nom me paraît être la bonne solution.
J'ai également remarqué que tu avais modifié la page "Accueil" en modifiant la formule, tu as été plus rapide que moi sur le coup

C'est bon, on peut enlever les lettres du Nom. Plus besoin de se casser la tête.
Le code sera donc composé des 2 derniers chiffres de l'année en cours et d'un code aléatoire.

NONO14 · 11 Octobre 2024

NONO14 à dit:
Les "cases à cocher" sont bien les CheckBox et les "boutons radio" les OptionButton ?

Pour alléger le code, on va remplacer les CheckBox par des OptionButton. J'en ai parlé au chef, et il m'a été répondu que pour la partie codification je devais me débrouiller sans toucher à la physionomie des feuilles.
J'ai en quelque sorte une petite carte blanche. Mais on ne va pas tout refaire pour autant.
Cependant, je vais devoir parcourir mes codes et autres modules pour supprimer ce qui est inutile.

wDog66 · 11 Octobre 2024

NONO14 à dit:
Pour alléger le code, on va remplacer les CheckBox par des OptionButton.

Bonjour,

Attention ! la finalité n'est pas la même

Checkbox permet de cocher 1 ou plusieurs cases,
alors que l'OptionButton est un bouton bascule, un seul à la fois

NONO14 · 11 Octobre 2024

wDog66 à dit:
Bonjour,

Attention ! la finalité n'est pas la même

Checkbox permet de cocher 1 ou plusieurs cases,
alors que l'OptionButton est un bouton bascule, un seul à la fois

Bonjour
C'est justement la finalité, ne pouvoir cocher qu'une seule case
Merci pour votre intervention

Microsoft 365 Modification impossible d'une TextBox

NONO14

XLDnaute Impliqué

Pièces jointes

TooFatBoy

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

wDog66

XLDnaute Occasionnel

NONO14

XLDnaute Impliqué

Discussions similaires