Gestion des acces

Gestion des acces - VB/VBA/VBS - Programmation

Marsh Posté le 02-08-2016 à 01:55:07    

Bonjour à tous
Je sollicite votre aide afin de pouvoir créé un fichier Excel avec gestion utilisateur
 
Le fichier Excel sera masqué sauf pour le login administrateur
Les feuilles seront accessibles en fonction de l'utilisateur
 
Pour ces 2 critères, je suis arrivé à faire quelque chose
 
Là ou je bloque, c'est que j'ai plusieurs userform et j'aimerai mettre en place le même système
 
Exemple : si login Eric mot de passe 1234 et qu'Eric a les droits que pour l'userform1 alors seul userform1 s'ouvre
Si login Paul mot de passe 12345 et que Paul a les droits pour userform3 et la feuil 2 alors feuil 2 et userform3 s'ouvre
Et si admin mot de passe 4567 alors classeur full visible
 
j'ai trouver ça mais je n'y comprend pas grand chose
 
dans le fichier dans this workbook il y a
 
Private Sub Workbook_Open()
GetSheets
VisibleFalse
Showme
End Sub
 
et dans l'userform
 
Option Explicit
Private Trial As Long
Private Sub cmdCheck_Click()
'Declare the variables
Dim AddData As Range, Current As Range
Dim user As Variant, Code As Variant
Dim PName As Variant, AName As Variant
Dim ws As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim result As Integer
Dim TitleStr As String
Dim msg As VbMsgBoxResult
 
'Variables
user = Me.txtUser.Value
Code = Me.txtPass.Value
TitleStr = "Password check"
result = 0
Set Current = Sheet2.Range("O8" )
 
'Error handler
On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user <> "" And Code <> "" Then
For Each AName In Sheet2.Range("T8:T108" )
'If AName = Code Then 'Use this for passcode text
If AName = CLng(Code) And AName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user
'Change variable if the condition is meet
result = 1
'Unload the form
Sheet2.Visible = True
Sheet2.Select
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next AName
End If
 
'Check user login with loop
If user <> "" And Code <> "" Then
For Each PName In Sheet2.Range("H8:H108" )
'If PName = Code Then 'Use this for passcode text
If PName = CLng(Code) And PName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Add usernmae to the worksheet
Current.Value = user
 
'unhide worksheet for user
If PName.Offset(0, 1) <> "" Then
Set ws = Worksheets(PName.Offset(0, 1).Value)
ws.Visible = True
End If
 
'unhide worksheet for user
If PName.Offset(0, 2) <> "" Then
Set ws2 = Worksheets(PName.Offset(0, 2).Value)
ws2.Visible = True
End If
 
'unhide worksheet for user
If PName.Offset(0, 3) <> "" Then
Set ws3 = Worksheets(PName.Offset(0, 3).Value)
ws3.Visible = True
End If
 
'show sheet tab if hidden
ActiveWindow.DisplayWorkbookTabs = True
 
'Change variable if the condition is meet
result = 1
'Unload the form
Unload Me
'Show the navigation form
'frmNavigation.Show
Exit Sub
End If
Next PName
End If
 
'Check to see if an error occurred
If result = 0 Then
'Increment error variable
Trial = Trial + 1
'Less then 3 error message
If Trial < 3 Then msg = MsgBox("Wrong password, please try again", vbExclamation + vbOKOnly, TitleStr)
Me.txtUser.SetFocus
'Last chance and close the workbook
If Trial = 3 Then
msg = MsgBox("Wrong password, the form will close…", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close False
End If
End If
Exit Sub
'Error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
MsgBox "Clicking the Close button does not work."
Cancel = True
End If
End Sub
 
j'ai trouvé ça pour lancé un userform a partir de son nom dans une cellule
 
Sub TEST()
 
 
'Cell A1 of Sheet1 contains the name of the UserForm
X = ActiveWorkbook.Sheets("Feuil1" ).Cells(1, 1).Value
 
VBA.UserForms.Add(X).Show
End Sub  :pt1cable:  
Je cherche à faire une gestion simple par tableau avec une colonne utilisateur un autre mot de passe et 4 colonnes feuille et 4 userform


Message édité par gilou le 02-08-2016 à 12:16:11
Reply

Marsh Posté le 02-08-2016 à 01:55:07   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed