Macro restriction d'accès

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,

Je souhaiterais limiter l'accès a ma fiche d'intervention.

Pour se faire j'ai une liste déroulante avec le nom des personnes autoriser.
Cette liste déroulante est sur mon interface sont label est "Accès maintenance".
classeur + interface + annexe en pièces

Interface ci dessous:
Pièce jointe 197723

Liste pour déterminer les accès au membres de l'équipe
Pièce jointe 197724

J'explique ce que je veux maintenant.
quand une personne sélectionne son nom dans la liste "une petite inputbox s'ouvre entrer mot de passe".
si le mot de passe est bon alors j'ai accès a la fiche d'intervention.

j'ai commencé à faire ceci:
Partie a l'ouverture de mon interface.
Code:

1 2 3 4 5 6 7 8 9 Private Sub UserForm_Initialize() With Sheets("Liste") For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row 'Liste des bancs de la feuille "Liste" Système.AddItem .Cells(i, 1) Next End With ComboBox1.RowSource = ("Liste") 'ComboBox1.RowSource = ("NomdelaListe") End Sub
Action réaliser par ma comboBox
Code:

1 2 3 4 5 6 7 8 Private Sub ComboBox1_Change() Dim MDP As String MDP = InputBox("Entrer votre mot de passe") Application.Visible = True Application.WindowState = xlMaximized Unload Me End Sub
Après je sais pas comment faire pour intégrer les droits de chacun via la liste fournit plus haut.

Ci joint le fichier excel:
http://www.fichier-xls.fr/2016/01/12...n-maintenance/

15/01/2016, 13h22
Menhir

Essayer de faire une procédure de contrôle d'accès avec une simple macro VBA, c'est comme faire de la chirurgie au couteau suisse.
Tu va te décarcasser pour finir par obtenir quelque chose qui aura des failles dans tous les coins.
Il va falloir protéger ta macro elle-même (en espérant te souvenir du mot de passe) parce que sinon, n'importe quel rigolo avec deux sous de jugeote ouvrira ton code et supprimera les lignes qui le gênent.
Il va falloir que tes utilisateurs sache protéger leur mot de passe. Avec une fenêtre InputBox, n'importe qui regardant par dessus leur épaule pourra le récupérer (j'espère que leurs bureaux ne sont pas en open space).
Sans compter qu'il est tout à fait possible dans Excel de ne pas accepter que les macros soient désactivées au démarrage.
Il faudra aussi faire en sorte que tes fichiers ne soient accessibles qu'avec ta macro.

Et si tu arrives à solutionner tout ce que je viens de lister, je suis certain que tes utilisateurs trouveront encore d'autres astuces de contournement.

Si tu veux vraiment protéger ton application, achète des outils permettant ce genre de développement.
Sinon, achète une barre à mine et tape sur la tête de tous ceux qui n'avancent pas droit. :mrgreen:
15/01/2016, 13h24
joe.levrai

Désolé j'ai répondu dans ton autre sujet comme un boulet : utilisation de la fonction Environ pour récupérer la variable "nom d'utilisateur" de la session Windows

http://www.developpez.net/forums/d15...o/#post8501977
15/01/2016, 13h38
rom1deh

Oui pour tous les problème que tu as citer j'ai réfléchit j'aime trouver un moyen de cacher le mot de passe quand on écrit en remplaçant les lettres par des étoiles.

Code:

PasswordChar = "*"

Voila après non c'est pas en open space je vais sécuriser mes macros pour ce faire un petit bout de programme à inscrire.
Pour désactiver la protection et la réactiver après la macro....

Mais merci de votre aide.

Voici un peut près ce que peux donner la chose.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
ThisWorkbook
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Fiche d'intervention").Visible = xlVeryHidden
Sheets("BDD").Visible = xlVeryHidden
Sheets("Liste").Visible = xlVeryHidden
End Sub
Private Sub Workbook_Open()
Sheets("Fiche d'intervention").Visible = xlVeryHidden
Sheets("BDD").Visible = xlVeryHidden
Sheets("Liste").Visible = xlVeryHidden
Application.Visible = False
fiche.Show 0
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Fiche
 
Private Sub ComboBox1_Change()
Dim MDP As String, Ligne As Long, Rep As Variant
MDP = InputBox("Entrer votre mot de passe")
 
If ComboBox1 = "" Then
    'Message à l'utilisateur
    MsgBox "Saisie du nom d'utilisateur obligatoire.", vbInformation
    'sortie de la procédure
    'Password = "*"
    Exit Sub
 
    Rep = VerifMDP(ComboBox1.Text, MDP)
    'c'est que le mot de passe ou l'utilisateur est faux donc
    'Message à l'utilisateur
    MsgBox "Erreur Mot de passe et/ou utilisateur. Merci de saisir à nouveau.", vbInformation
    'on vide les 2 textbox
    ComboBox1 = ""
    'on sort de la procédure
    Exit Sub
End If
'A partir d'ici, le code ne se déroule que lorsque mdp et nom sont corrects.
With Sheets("Liste")
    If Application.VLookup(Me.ComboBox1.Text, .[C:D], 2, 0) = MDP Then
        Ligne = Application.Match(Me.ComboBox1.Text, .[C:C], 0)
        If .Cells(Ligne, 5).Value = "X" Then Sheets("Fiche d'intervention").Visible = True
        If .Cells(Ligne, 6).Value = "X" Then Sheets("BDD").Visible = True
        If .Cells(Ligne, 7).Value = "X" Then Sheets("Liste").Visible = True
    End If
End With
 
'On peut donc afficher les feuilles correspondants à l'utilisateur saisi
'AfficheFeuilles TextBox1
'masque l'UserForm
'UserForm1.Hide
'End Sub
Application.Visible = True
Application.WindowState = xlMaximized
Unload Me

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Module
 
Public Function VerifMDP(Utilisateur As String, MDP As String) As Boolean
Dim rngTrouve As Range
VerifMDP = False 'par défaut, renvoie FAUX
 
With Sheets("Liste") 'dans la feuille paramétrage
     'cherche, colonne C, le nom d'utilisateur saisi
    Set rngTrouve = .Columns(3).Cells.Find(Utilisateur, lookat:=xlWhole)
    If rngTrouve Is Nothing Then 'si il ne trouve pas
        VerifMDP = False 'la fonction renvoie faux
    Else 's'il le trouve
        'vérifie que le mot saisi feuille parametrgae colonne D est identique
        'au mot de passe saisi dans l'inputbox
        If rngTrouve.InputBox(0, 1) <> MDP Then
            VerifMDP = False 'si FAUX
        Else
            VerifMDP = True 'si VRAI
        End If
    End If
End With
End Function
Sub AfficheFeuilles(Utilisateur As String)
Dim Col As Byte, i As Byte, Lig As Integer
 
With Sheets("Liste") 'dans la feuille Liste
    'comme on va boucler de la colonne 4 à la dernière colonne, on stocke le n° de la dern colonne :
    Col = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
    'on cherche colonne D le nom d'utilisateur saisi et on stocke son num de ligne
    Lig = .Columns(4).Cells.Find(Utilisateur, lookat:=xlWhole).Row
    For i = 5 To Col
        If UCase(.Cells(Lig, i)) = "X" Then 'si on trouve un "X" dans la cellule
            Sheets(.Cells(1, i).Value).Visible = True 'on affiche la feuille
        Else
            Sheets(.Cells(1, i).Value).Visible = xlSheetVeryHidden 'sinon on la masque
        End If
    Next i
End With
End Sub
Sub test()
Sheets("Liste").Visible = True
End Sub

Ceci fonctionne presque quelques petit détail a réglé pour afficher les messages si mdp faux

Donc voici la version final pour la restriction d'accès.

Partie Thisworkbook.

Code:

1
2
3
4
5
6
7
8
9
10
11
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Fiche d'intervention").Visible = xlVeryHiddenSheets("BDD").Visible = xlVeryHidden
Sheets("Liste").Visible = xlVeryHidden
End Sub
 
Private Sub Workbook_Open()
Sheets("Fiche d'intervention").Visible = xlVeryHidden
Sheets("BDD").Visible = xlVeryHidden
Sheets("Liste").Visible = xlVeryHidden
Application.Visible = False
End Sub

Partie UserForm

Code:

1
2
3
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.WindowState = xlMaximized
End Sub

Partie Module.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Public Function VerifMDP(Utilisateur As String, MDP As String) As Boolean
Dim rngTrouve As Range
VerifMDP = False 'par défaut, renvoie FAUX
 
With Sheets("Liste") 'dans la feuille paramétrage
     'cherche, colonne C, le nom d'utilisateur saisi
    Set rngTrouve = .Columns(3).Cells.Find(Utilisateur, lookat:=xlWhole)
    If rngTrouve Is Nothing Then 'si il ne trouve pas
        VerifMDP = False 'la fonction renvoie faux
    Else 's'il le trouve
        'vérifie que le mot saisi feuille parametrgae colonne D est identique
        'au mot de passe saisi dans l'inputbox
        If rngTrouve.InputBox(0, 1) <> MDP Then
            VerifMDP = False 'si FAUX
        Else
            VerifMDP = True 'si VRAI
        End If
    End If
End With
End Function
Sub AfficheFeuilles(Utilisateur As String)
Dim Col As Byte, i As Byte, Lig As Integer
 
With Sheets("Liste") 'dans la feuille Liste
    'comme on va boucler de la colonne 4 à la dernière colonne, on stocke le n° de la dern colonne :
    Col = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
    'on cherche colonne D le nom d'utilisateur saisi et on stocke son num de ligne
    Lig = .Columns(4).Cells.Find(Utilisateur, lookat:=xlWhole).Row
    For i = 5 To Col
        If UCase(.Cells(Lig, i)) = "X" Then 'si on trouve un "X" dans la cellule
            Sheets(.Cells(1, i).Value).Visible = True 'on affiche la feuille
        Else
            Sheets(.Cells(1, i).Value).Visible = xlSheetVeryHidden 'sinon on la masque
        End If
    Next i
End With
End Sub
Sub test()
Sheets("Liste").Visible = True
End Sub

Après se référé a l'userform placé en haut au premie rposte pour voir le model.