Microsoft 365 Modification impossible d'une TextBox

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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
🖖

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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
🖖

Cliquez pour agrandir...

NONO14 à dit:

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

Cliquez pour agrandir...

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 😉

Cliquez pour agrandir...

NONO14 à dit:

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

Cliquez pour agrandir...

NONO14 à dit:

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...