XL 2016 Modification de droits d'accès par UF

[ReneDav14000]

Bonjour à toutes et à tous,
J'ai créé un formulaire pour gérer les droits d'accès des utilisateurs.
Certains agents existent déjà et peuvent voir leurs droits être modifiés et d'autres nouveaux utilisateurs se voir attribuer des droits d'accès.
Dans la feuille "Accès" du fichier ci-joint il y a un tableau nommé "List_User" dans lequel sont entrés des noms avec un mot de passe et des croix indiquant leur(s) droit(s).
Donc si un agent existe déjà et qu'on lui modifie ses droits, des croix doivent être ajoutées ou supprimées.
Pour un nouvel arrivant il ne peut y avoir que des ajouts de croix et l'attribution d'un mot de passe limité à 7 caractères.

Pourriez-vous m'aider à réaliser ce projets s'il vous plait car je n'y arrive pas ?
En vous en remerciant par avance

PS : J'ai oublié une donnée importante, certains utilisateurs peuvent avoir accès à certaine feuille en lecture seulement. Désolé pour cet oubli

 

[ReneDav14000]

Bonsoir à tous,
Voici où j'en suis dans mon projet.
La Combo est alimenté avec les données de la feuille "Accès" ce qui a pour effet d'alimenter également les TextBox.
J'ai ajouté un bouton "Ajouter". Lorsque l'on clique sur le bouton "Modifier" la TextBox "TextNOM" est cachée et la ComboUtil est affichée, lorsque l'on clique sur "Ajouter" c'est l'inverse, la Combo est cachée et la TextBox est visible.
J'ai également modifié le tableau de la feuille "Accès".
J'ai essayé de faire le reste (comme décrit dans mon premier post, mais sans grand succès.
Voici le nouveau fichier avec les modifs
Si vous aviez un peu de temps pour m'aider je vous en serais reconnaissant.

 

[ChTi160]

Bonsoir ReneDav14000
Je crois que ton Fichier est un peu légé !
Sur ton Userform tu as un Textbox Prénom ????
à quoi correspondent les Boutons mentionnés sur le Userform
Ex : "Bouton de gestion des agents"
Dans ton Userform comment cela doit ce passer ?
Dans le ComBobox "NOM de L'agent" ,Tu as quoi ? la Liste des Agents ?
etc etc
Jean marie

 

[ReneDav14000]

Bonsoir ChTi160,
Après avoir lu ton message, je me rend compte qu'il a une partie de mon UF qui ne sert à rien, ou qui fait redondance.
Je modifie mon UF et je reviens avec plus d'infos.
Merci d'avoir soulevé le lièvre...

 

[ReneDav14000]

Bon, j'ai refait mon UF et j'ai mis toutes les explications dans la feuille
J'espère que vous pourrez m'aider car je suis en peine.

 

[ReneDav14000]

Bonjour le forum,
J'ai avancé dans mon projet, toutefois je rencontre un problème lors de l'ajout d'un agent en cliquant sur le bouton ValiderAjout du formulaire.
Le tableau ne se remplit pas des données du formulaire et je ne vois pas où est l'erreur.
Pouvez-vous y jeter un œil s'il vous plaît ?
Pour ajouter un agent il faut cliquer sur le bouton "ajouter"
Je vous en remercie par avance

 

[dysorthographie]

Bonjour,

Private Sub BoutValidAjout_Click()
Dim Ligne As Range
Application.ScreenUpdating = False

If Me.TextNOM.Value = "" Then
 MsgBox "Vous devez obligatoirement saisir un NOM."
Exit Sub
End If
Sheets("Accès").Visible = True
If MsgBox("Confirmez-vous les droits pour cet(te) employé(e) ?", vbYesNo, "Demande de confirmation de création") = vbYes Then
    If Not ThisWorkbook.Sheets("Accès").Range("A:A").Find(CStr(Me.TextNOM.Value), LookIn:=xlValues) Is Nothing Then
        MsgBox Me.TextNOM.Value & " Existe déja", vbExclamation
        Exit Sub
    End If

    With Sheets("Accès").ListObjects(1)
        If .InsertRowRange Is Nothing Then
            Set Ligne = .ListRows.Add().Range
            Ligne(1, 1).Value = Me.TextNOM.Value
            Ligne(1, 2).Value = Me.TextPrenom.Value
            Ligne(1, 3).Value = Me.TextMdP.Value
            Ligne(1, 4).Value = "X"
           Set Ligne = Nothing
        End If
       
        Worksheets("Accès").Range("A:L").Columns.AutoFit
    End With
End If
Application.ScreenUpdating = True
End Sub

 

[ReneDav14000]

Bonsoir dysorthographie,
Merci beaucoup pour ton aide, toutefois il ne se passe rien, le tableau ne se remplit pas.
Je travaille sur un tableau structuré qui porte le nom de List_User. Je ne comprends pas ce qui se passe

PS : C'est bon ça fonctionne une petite erreur de ma part, toutes mes excuses
Encore merci pour ton aide.

 

[ReneDav14000]

Bonsoir,
Je reviens un instant sur ce post. La gestion du doublon du Nom saisi est intéressant, toutefois j'aimerai y ajouter également un contrôle sur le prénom, car il se peut que deux personnes portent le même nom (les MARIE par exemple) mais plus rarement le même prénom.
Merci par avance

 

[dysorthographie]

pas de problème.

Private Sub BoutValidAjout_Click()
Dim Ligne As Range
Application.ScreenUpdating = False

If Me.TextNOM.Value = "" Then
 MsgBox "Vous devez obligatoirement saisir un NOM."
Exit Sub
End If
Sheets("Accès").Visible = True
If MsgBox("Confirmez-vous les droits pour cet(te) employé(e) ?", vbYesNo, "Demande de confirmation de création") = vbYes Then
    If CBool(NomPnom(CStr(Me.TextNOM.Value), CStr(Me.TextPrenom.Value), ThisWorkbook.Sheets("Accès").Range("A:A"))) Then
    ' Not ThisWorkbook.Sheets("Accès").Range("A:A").Find(CStr(Me.TextNOM.Value), LookIn:=xlValues) Is Nothing Then
        MsgBox Me.TextNOM.Value & " " & Me.TextPrenom.Value & " Existe déja", vbExclamation
        Exit Sub
    End If

    With Sheets("Accès").ListObjects(1)
        If .InsertRowRange Is Nothing Then
            Set Ligne = .ListRows.Add().Range
            Ligne(1, 1).Value = Me.TextNOM.Value
            Ligne(1, 2).Value = Me.TextPrenom.Value
            Ligne(1, 3).Value = Me.TextMdP.Value
            Ligne(1, 4).Value = "X"
           Set Ligne = Nothing
        End If
      
        Worksheets("Accès").Range("A:L").Columns.AutoFit
    End With
End If
Application.ScreenUpdating = True
End Sub
"***********************************************************************************************************
'    fonction recherche de doublons!
'-----------------------------------------------------------------------------------------------------------
Function NomPnom(Nom As String, Prenom As String, Plage As Range, Optional Appre As String = "A1") As Integer
Dim r As Range, Pos As Integer
Set r = Plage.Find(Nom, After:=Range(Appre), LookIn:=xlValues)
If Not r Is Nothing Then
    If Range(Appre).Row > r.Row Then NomPnom = 0: Exit Function
    If r.Offset(, 1) <> Prenom Then NomPnom = NomPnom(Nom, Prenom, Plage, r.Address) Else NomPnom = r.Row
Else
    NomPnom = 0
End If
End Function
"***********************************************************************************************************

 

[ReneDav14000]

Merci dysorthographie, mais j'ai un message d'erreur "Espace pile insuffisant" sur ce code à 6ème ligne

'"***********************************************************************************************************
'    fonction recherche de doublons!
'-----------------------------------------------------------------------------------------------------------
Function NomPnom(Nom As String, Prenom As String, Plage As Range, Optional Appre As String = "A1") As Integer
Dim r As Range, Pos As Integer
Set r = Plage.Find(Nom, After:=Range(Appre), LookIn:=xlValues)
If Not r Is Nothing Then
    If Range(Appre).Row > r.Row Then NomPnom = 0: Exit Function
   [B] If r.Offset(, 1) <> Prenom Then NomPnom = NomPnom(Nom, Prenom, Plage, r.Address) Else NomPnom = r.Row[/B]
Else
    NomPnom = 0
End If
End Function
'"***********************************************************************************************************

 

[patricktoulon]

re
enlève les balises "B" saucisse!!!

c'est la manie de robert ça il laisse toujours une bellugue

 

[dysorthographie]

Salut Patrick,
Sur mon code la balise n'y est pas !

 

[patricktoulon]

re
autant pour moi robert
c'est aussi la manie de @ReneDav14000
faut toujours qu'il rajoute des truc que tu lui a pas donné

 

[ReneDav14000]

Exact, c'est moi qui les ai mis pour marquer l'endroit de l'erreur.
Je réponds de mon téléphone.