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 =...

patricktoulon · 30 Novembre 2022

ah ben v'la aut'chose tiens
en effet moi non plus ,je suis pas sur de pouvoir tester sur mon tel

dysorthographie · 30 Novembre 2022

Nouvelle mouture!
J'imagine que tu devras faire la même chose pour le bouton modifier car actuellement tu ne cherches que le nom!

Note que la fonction NomPnom retourne la ligne du couple nom prénom trouvé.

VB:

'***********************************************************************************************************
'   fonction recherche de doublons!
'-----------------------------------------------------------------------------------------------------------
Function NomPnom(Nom As String, Prenom As String, Plage As Range) As Integer
Dim r As Range, Pos As Integer
pose = 1
Do While pose <> 0
Set r = Plage.Find(Nom, After:=Plage(pose, 1), LookIn:=xlValues)
If Not r Is Nothing Then
    If pose => r.Row Then NomPnom = 0: Exit Function
   If UCase(r.Offset(, 1)) = UCase(Prenom) Then NomPnom = r.Row: Exit Function
   pose = r.Row
Else
    NomPnom = 0
    pose = 0
End If
Loop
End Function
'***********************************************************************************************************

ReneDav14000 · 1 Décembre 2022

patricktoulon à dit:
ah ben v'la aut'chose tiens
en effet moi non plus ,je suis pas sur de pouvoir tester sur mon tel

Bonjour patrick,
J'ai eu une coupure sur le réseau fibre qui vient d'être rétablie, ce sont malheureusement des choses qui arrivent.
Bonne journée à toi

ReneDav14000 · 1 Décembre 2022

dysorthographie à dit:

Nouvelle mouture!
J'imagine que tu devras faire la même chose pour le bouton modifier car actuellement tu ne cherches que le nom!

Note que la fonction NomPnom retourne la ligne du couple nom prénom trouvé.

VB:

'***********************************************************************************************************
'   fonction recherche de doublons!
'-----------------------------------------------------------------------------------------------------------
Function NomPnom(Nom As String, Prenom As String, Plage As Range) As Integer
Dim r As Range, Pos As Integer
pose = 1
Do While pose <> 0
Set r = Plage.Find(Nom, After:=Plage(pose, 1), LookIn:=xlValues)
If Not r Is Nothing Then
    If pose => r.Row Then NomPnom = 0: Exit Function
   If UCase(r.Offset(, 1)) = UCase(Prenom) Then NomPnom = r.Row: Exit Function
   pose = r.Row
Else
    NomPnom = 0
    pose = 0
End If
Loop
End Function
'***********************************************************************************************************

Bonjour dysorthographie,
Merci beaucoup. Cette fonction je l'a mets dans un module ou dans le code de la textbox, c'est pour m'assurer de bien faire. Le dernier je l'avais mis dans le code de la Text

ReneDav14000 · 1 Décembre 2022

Re,
C'est bon Dysorthographie, ça fonctionne bien. Je vais faire la même chose pour le bouton validerModif.
Encore merci

dysorthographie · 1 Décembre 2022

Bonjour,
Si tu avais un problème pour l'intervention dans le bouton modifier, n'hésites pas.

ReneDav14000 · 1 Décembre 2022

dysorthographie à dit:
Bonjour,
Si tu avais un problème pour l'intervention dans le bouton modifier, n'hésites pas.

C'est bon j'ai réussi sans problème.
Merci beaucoup

Maintenant je cherche à trier automatiquement la feuille "Accès" à chaque saisie ou bien la Combo, je ne sais pas ce qu'il y a de mieux

patricktoulon · 1 Décembre 2022

Bonjour à tout les deux

moi j'ai rien compris en fait
a quoi sert cette fonction ?

dysorthographie · 1 Décembre 2022

Bonjour Patrick,
Cette fonction fait une recherche sur le couple nom prénom et retourne le RowNum

J'ai cherché pour un tableau structuré ,ou je suis pas très doué, j'ai rien trouvé !

Si tu as mieux je suis preneur !

ReneDav14000 · 1 Décembre 2022

Voilà c'est fait. Le tri se fait dans la combo.
voici le code (merci Monsieur Boisgontier)

VB:

Private Sub UserForm_Initialize()
Me.ComboUtil.Visible = False
Me.TextNOM.Visible = False
Set f = Sheets("Accès")
a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row))
    Call Tri(a, LBound(a), UBound(a))
    Me.ComboUtil.List = a
End Sub
'*************************************************************************'
Sub Tri(a, gauc, droi)
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
    temp = a(g): a(g) = a(d): a(d) = temp
    g = g + 1: d = d - 1
    End If

Loop While g <= d

    If g < droi Then Call Tri(a, g, droi)
    If gauc < d Then Call Tri(a, gauc, d)
End Sub

ReneDav14000 · 1 Décembre 2022

dysorthographie à dit:
Bonjour Patrick,
Cette fonction fait une recherche sur le couple nom prénom et retourne le RowNum

J'ai cherché pour un tableau structuré ,ou je suis pas très doué, j'ai rien trouvé !

Si tu as mieux je suis preneur !

patricktoulon à dit:
Bonjour à tout les deux

moi j'ai rien compris en fait
a quoi sert cette fonction ?

Bonjour patrick,
Cette fonction fonctionne très bien même sur un tableau structuré. J'ai fait plusieurs test.
Je ne suis pas assez doué en la matière pour aller chercher mieux.

ReneDav14000 · 3 Décembre 2022

Bonjour le forum,
Je reviens vers vous un instant car je rencontre un petit problème.
Dans mon application j'ai 2 LEGROS Jacques comme employés mais ils ont chacun un code différent (heureusement !).
Est-il possible de faire également un contrôle sur la TextMdP en plus de la fonction proposée par Dysorthographie au Post 17 que je répète ici :
Merci par avance
De plus, dans ma ComboUtil lorsque je clique sur LEGROS, c'est toujours le 1er qui a le focus, même si je clique sur le 2nd LEGROS.

VB:

Function NomPnom(Nom As String, Prenom As String, Plage As Range) As Integer
Dim r As Range, Pos As Integer
pose = 1
Do While pose <> 0
Set r = Plage.Find(Nom, After:=Plage(pose, 1), LookIn:=xlValues)
If Not r Is Nothing Then
    If pose => r.Row Then NomPnom = 0: Exit Function
   If UCase(r.Offset(, 1)) = UCase(Prenom) Then NomPnom = r.Row: Exit Function
   pose = r.Row
Else
    NomPnom = 0
    pose = 0
End If
Loop
End Function

patricktoulon · 3 Décembre 2022

re
il me semble t'avoir donné cela il y a un moment déjà je crois non ?
a savoit un userform login / mdp travaillant sur un tableau de 2 colonnes

dysorthographie · 3 Décembre 2022

Bonsoir,
Ça va sans dire ma ça va mieux en le disant,il faut ajouter le TextMdP dans l'appel de la fonction !

Code:

Function NomPnom(Nom As String, Prenom As String,MPass as string, Plage As Range) As Integer
Dim r As Range, Pos As Integer
pose = 1
Do While pose <> 0
Set r = Plage.Find(Nom, After:=Plage(pose, 1), LookIn:=xlValues)
If Not r Is Nothing Then
    If pose => r.Row Then NomPnom = 0: Exit Function
   If UCase(r.Offset(, 1)) = UCase(Prenom) AND 
MPass =r.Offset(, 2) Then NomPnom = r.Row: Exit Function
   pose = r.Row
Else
    NomPnom = 0
    pose = 0
End If
Loop
End Function

ReneDav14000 · 3 Décembre 2022

patricktoulon à dit:
re
il me semble t'avoir donné cela il y a un moment déjà je crois non ?
a savoit un userform login / mdp travaillant sur un tableau de 2 colonnes

patricktoulon à dit:

re
il me semble t'avoir donné cela il y a un moment déjà je crois non ?
a savoit un userform login / mdp travaillant sur un tableau de 2 colonnes

Cliquez pour agrandir...

Bonsoir patrick,

Bonsoir patrick,
Ce n'est pas trop histoire de login/mdp mais de remplissage de la combo.
Les deux sont liés dans mon application. Mais mon soucis tient aux doublons des Noms, prénoms, seul les codes d'accès sont différents. Par exemple, je travaille avec 4 MARIE Philippe.
Merci toutefois pour ta remarque.
Bonne soirée

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

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

dysorthographie

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

ReneDav14000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

Discussions similaires