Mot de passe avec des accès pour Projet VBA

Version imprimable

17/07/2022, 00h08
dalisoon

1 pièce(s) jointe(s)

Mot de passe avec des accès pour Projet VBA

Bonsoir les amis :
J'ai besoin de votre aide pour avoir avoir des niveaux d'accès :

Identifiant : USER Mot de passe : USER >>> cet utilisateur doit juste accès sur le USERFORM pour juste lecture et non modification
Identifiant : ADMIN Mot de passe : USER09 >>> cet utilisateur doit juste accès sur le USERFORM pour modification et lecture

Merci
Pièce jointe 622386

Bonjour,

J'ai ce code que j'ai déjà utilisé et qui devrait pouvoir faire l'affaire en l'arrangeant un peu selon tes besoins.
Selon le mot de passe inscrit dans une ImputBox, une feuille s'affiche ou pas, ça doit être adaptable à ton projet.
Meilleures salutations

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
 
Option Explicit
 
Public oFeuilleActive As Excel.Worksheet
Const sMdP2 As String = "toto"
Const sMdP3 As String = "tata"
 
Private Sub Workbook_Open()
ThisWorkbook.Worksheets("Feuil1").Activate
Set oFeuilleActive = ThisWorkbook.Worksheets("Feuil1")
End Sub
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim sReponse As String
 
Application.EnableEvents = False
oFeuilleActive.Activate
 
Select Case Sh.Name
    Case "Feuil1"
        Set oFeuilleActive = Sh
    Case "Feuil2"
        sReponse = InputBox("Mot de passe?")
        If sReponse = sMdP2 Then Set oFeuilleActive = Sh
 
    Case "Feuil3"
        sReponse = InputBox("Mot de passe?")
        If sReponse = sMdP3 Then Set oFeuilleActive = Sh
 
End Select
 
oFeuilleActive.Activate
Application.EnableEvents = True
 
End Sub

Sinon, il y a cet autre code mais qui oblige à faire un tableau sur feuille en 2 colonnes avec les droits d'accès par utilisateurs, une colonne ADMIN pour les personnes autorisée et une autre, pour les utilisateurs restreints.
Je ne me rappelle plus qui m'avait donné ce code sur le forum (PatrickToulon) peut-être que je remercie au passage.

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
 
Public Sub ControlLogin()
 'Déclaration
    Dim hideFeuil() As String
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim idUser As String
    Dim accesTabAdmin() As Variant, accesTabUser As Variant
    Dim I As Integer, iBis As Integer, Y As Integer
    Set xlApp = Excel.Application
 
    'Protection des feuilles
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect
    Next ws
 
    'Creation d'un tableau contenant le nom des feuilles
    ReDim hideFeuil(1 To ThisWorkbook.Worksheets.Count)
 
    For Y = 1 To ThisWorkbook.Worksheets.Count
        hideFeuil(Y) = ThisWorkbook.Worksheets(Y).Name
    Next Y
 
    Set xlSheet = Sheets("GestionAcces") 'Feuille contenant les LOGIN autorisés
 
    I = xlSheet.Range("a65536").End(xlUp).Row 'Dans la colonne A : liste des Admin
    iBis = xlSheet.Range("B65536").End(xlUp).Row 'Dans la colonne B : liste des Users simple
 
    'Récupération de l'ID de l'utilisateur connecté
    idUser = Environ("USERNAME")
 
    'dimensionnement d'un tableau contenant les log des admin
    ReDim accesTabAdmin(1 To I - 1)
    For X = 1 To I - 1
        accesTabAdmin(X) = xlSheet.Range("a" & X + 1).Value
    Next X
 
    For X = LBound(accesTabAdmin) To UBound(accesTabAdmin)
 
        'comparaison de l'ID connecté au tableau des admin
        'si l'ID est = , accès total au fichier
        If idUser = accesTabAdmin(X) Then
            MdPForm.Show
            If UserCheckPassword(idUser, MdPForm.motDP.Value) = True Then 'Demande du mot de passe réseau
                MdPForm.motDP.Value = ""
                Worksheets("Start").Activate
                MsgBox "Accès total au fichier" & Chr(10) & "Attention à ne pas modifier les paramètres involontairement", vbInformation, "Contrôle d'accès"
 
                'Affichage de toutes les feuilles pour les admins
                For Y = 1 To UBound(hideFeuil)
                    Sheets(hideFeuil(Y)).Visible = True
                Next Y
                Sheets("Alerte").Visible = False
            Else
                MsgBox "mauvais mot de passe, fermeture du fichier"
                Set xlSheet = Nothing
                xlApp.Quit
                Set xlApp = Nothing
            End If
            Exit Sub
        End If
    Next X
 
    'sinon on dimensionne un tableau qui récupère la liste des Users
    ReDim accesTabUser(1 To iBis - 1)
    For X = 1 To iBis - 1
        accesTabUser(X) = xlSheet.Range("B" & X + 1).Value
    Next X
 
    For X = LBound(accesTabUser) To UBound(accesTabUser)
        'si l'ID connecté == , accès en tant que Users
        If idUser = accesTabUser(X) Then
            Worksheets("Start").Activate
 
            'Affichage des sheets accessible pour les users (Pas toutes les feuilles, seul la feuille 1 et 2)
            For Y = 1 To 2
                Sheets(hideFeuil(Y)).Visible = True
            Next Y
            Sheets("Alerte").Visible = False
            Exit Sub
        End If
    Next X
 
    'sinon affichage du form d'info et fermeture de l'appli
    BoxInformation.Show
    xlApp.DisplayAlerts = False
    ThisWorkbook.Save
    xlApp.Quit
End Sub
 
'Purpose   :    Checks if a the NT password for a user is correct.
'Inputs    :    UserName The username
'               Password The password
'               [Domain] If DOMAIN is omitted uses the local account database.
'Outputs   : Returns True if the password and user name are valid.
'Notes     : Windows NT and 2000 ONLY. Requires correct permissions to run (must have
'               the SE_TCB_NAME privilege. In User Manager, this is the "Act as part of the
'               Operating System" right).
 
Function UserCheckPassword(ByVal Username As String, ByVal Password As String, Optional ByVal Domain As String = vbNullString) As Boolean
    Dim lRet As Long, hToken As Long
 
    Const LOGON32_LOGON_NETWORK = 3&            'Intended for high performance servers to authenticate clear text passwords
    Const LOGON32_LOGON_INTERACTIVE = 2&        'Intended for users who will be interactively using the machine, such as a user being logged on by a terminal server
    Const LOGON32_LOGON_BATCH = 4&
 
    Const LOGON32_PROVIDER_DEFAULT = 0&         'Use the standard logon provider for the system
    Const LOGON32_PROVIDER_WINNT40 = 2&         'Use the Windows NT 4.0 logon provider
    Const LOGON32_PROVIDER_WINNT35 = 1&         'Use the Windows NT 3.5 logon provider
    Const LOGON32_PROVIDER_WINNT50 = 3&         'Use the Windows 2000 logon provider.
 
    'Check the username and password
    lRet = LogonUser(Username, Domain, Password, LOGON32_LOGON_NETWORK, LOGON32_PROVIDER_DEFAULT, hToken)
 
    If lRet Then
        'Password correct
        UserCheckPassword = True
        CloseHandle hToken
    'Else
        'Failed:
        'MsgBox "Error: " & DLLErrorText(Err.LastDllError)
    End If
End Function

18/07/2022, 20h53
dalisoon

Salut
j'ai essayé mais j'ai un code erreur 9

Est ce que tu peux partager le fichier avec le code si ça fonctionne pour toi
19/07/2022, 09h57
NONO14000

Bonjour dalisoon,

Désolé mais je n'ai plus le fichier en question. J'ai gardé le code en réserve.
Mets ton code en pièce jointe, il y a aura certainement une bonne âme pour nous aider à résoudre ton problème
Très cordialement
19/07/2022, 09h59
NONO14000

voici ce que dit l'aide :

Citation:

Les éléments de tableaux et les membres de collections ne sont accessibles que dans leurs plages définies. Causes et solutions pour cette erreur :

Vous avez référencé un élément de tableau qui n'existe pas. L'indice peut être plus grand ou plus petit que la plage d'indices possibles, ou le tableau n'a pas de dimensions affectées à ce point dans l'application. Vérifiez la déclaration du tableau pour contrôler ses limites supérieure et inférieure. Utilisez les fonctions UBound et LBound pour conditionner les accès au tableau si vous utilisez des tableaux redimensionnés. Si l'index est spécifié en tant que variable, vérifiez l'orthographe du nom de la variable.

Vous avez déclaré un tableau, mais vous n'avez pas spécifié le nombre d'éléments. Par exemple, le code suivant génère cette erreur :

VB

Copier
Dim MyArray() As Integer
MyArray(8) = 234 ' Causes Error 9.

Visual Basic ne dimensionne pas implicitement les plages de tableau non spécifiées en tant que 0 - 10. Au lieu de cela, vous devez utiliser Dim ou ReDim pour spécifier de manière explicite le nombre d’éléments dans une matrice.

Vous avez référencé un membre de collection qui n'existe pas. Essayez d'utiliser la construction For Each...Next plutôt que de spécifier les éléments d'index.

Vous avez utilisé une forme abrégée d'indice qui a explicitement spécifié un élément non valide. Par exemple, lorsque vous utilisez le ! operator with a collection, the ! implicitly specifies a key. Par exemple, objet!keyName. la valeur est égale à objet. élément (keyName). valeur. Dans ce cas, une erreur est générée si keyname représente une clé non valide dans la collection. To fix the error, use a valid key name or index for the collection.