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

ReneDav14000 · 29 Novembre 2022

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

dysorthographie · 3 Décembre 2022

désolé!

VB:

Private Sub ComboUtil_Change()
If Me.ComboUtil.Value = "" Or Me.TextPrenom.Value = "" Or Me.TextMdP.Value = "" Then Exit Sub

With ThisWorkbook.Sheets("Accès")
    Dim I As Integer: I = NomPnom(ComboUtil.Value, TextPrenom.Value, TextMdP.Value, .Range("A:A"))
    If I = 0 Then MsgBox "Pas trouvé": Exit Sub
    With .Cells(I, "A")
        Me.TextPrenom.Value = .Cells.Offset(, 1)
        Me.TextMdP = .Cells.Offset(, 2)
        Me.CheckBoutAgent = .Cells.Offset(, 3) = "X" 'True/False
        Me.CheckBouEntSort = .Cells.Offset(, 4) = "X"
        Me.CheckBoutHor = .Cells.Offset(, 5) = "X"
        Me.CheckBoutEtiq = .Cells.Offset(, 6) = "X"
        Me.CheckFeuilCalcul = .Cells.Offset(, 7) = "X"
        Me.CheckFeuilData =...

ReneDav14000 · 29 Novembre 2022

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 · 29 Novembre 2022

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 · 29 Novembre 2022

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 · 29 Novembre 2022

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 · 30 Novembre 2022

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 · 30 Novembre 2022

Bonjour,

VB:

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 · 30 Novembre 2022

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 · 30 Novembre 2022

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 · 30 Novembre 2022

pas de problème.

Code:

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 · 30 Novembre 2022

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

VB:

'"***********************************************************************************************************
'    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 · 30 Novembre 2022

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

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

dysorthographie · 30 Novembre 2022

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

patricktoulon · 30 Novembre 2022

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 · 30 Novembre 2022

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

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

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

dysorthographie

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

ChTi160

XLDnaute Barbatruc

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

ReneDav14000

XLDnaute Occasionnel

Discussions similaires