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

R

ReneDav14000

XLDnaute Occasionnel
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
 

Pièces jointes

  • Utilisateur.xlsm
    16.3 KB · Affichages: 19
Dernière édition:
Solution
dysorthographie
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 =...
Trier par date Trier par votes
R

ReneDav14000

XLDnaute Occasionnel
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.
 

Pièces jointes

  • Utilisateur.xlsm
    28.8 KB · Affichages: 5
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
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.
1669745850172.png
 

Pièces jointes

  • Utilisateur.xlsm
    29.1 KB · Affichages: 5
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
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
 

Pièces jointes

  • Utilisateur.xlsm
    102.3 KB · Affichages: 5
Vote positif 0 Vote négatif
dysorthographie

dysorthographie

XLDnaute Accro
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
 
Dernière édition:
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
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 o_O

PS : C'est bon ça fonctionne une petite erreur de ma part, toutes mes excuses
Encore merci pour ton aide.
 
Dernière édition:
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
dysorthographie

dysorthographie

XLDnaute Accro
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
"***********************************************************************************************************
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
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
'"***********************************************************************************************************
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
XL 2016 Stats effectif de personnel
Réponses
5
Affichages
277
jcoillot
J
P
  • Résolu(e)
Microsoft 365 Problème d'affichage étiquettes Graphique
Réponses
8
Affichages
155
Piment
P
C
  • Question
XL 2021 Dupliquer un fichier selon une liste déroulante
Réponses
2
Affichages
146
catdog
C
A
  • Question
Microsoft 365 Verrouillage d'une partie d'une feuille
Réponses
1
Affichages
186
Phil69970
Phil69970
G
  • Résolu(e)
Microsoft 365 Formulaire saisie
Réponses
3
Affichages
556
gpion
G
A
  • Question
Microsoft 365 Modification de mise en forme conditionnelle
Réponses
2
Affichages
376
Anne13
A
M
  • Question
XL 2016 Excel UserForm VBA
Réponses
3
Affichages
468
patricktoulon
patricktoulon
L
  • Question
Microsoft 365 masquer colonne + MDP
Réponses
2
Affichages
392
l.et.lilou
L
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
144
NONO14
N
Armisa
  • Résolu(e)
XL 2016 Suivi location de voiture
Réponses
4
Affichages
330
Armisa
Armisa

Membres actuellement en ligne

6 membres et 91 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 486
Messages
2 110 107
Membres
110 666
dernier inscrit
Yaya123