Const FEUILLE_ACCUEIL As String = "Accueil" 'à adapter
Const FEUILLE_DROITS As String = "parametrage" 'à adapter
Type StructAutorises
Feuille As String
Plage As String
End Type
Public USER$
Public MDP$
Public Autorises() As StructAutorises
Sub VisibiliteFeuilleEtPlageAutorisee()
Dim S As Worksheet
Dim S2 As Worksheet
Dim var
Dim i&
Dim j&
Dim NumVarLig&
Dim cpt& 'compteur
'--- Seule la feuille Accueil est rendue visible ---
With Sheets(FEUILLE_ACCUEIL)
.Visible = True
.Activate
End With
For Each S In ThisWorkbook.Worksheets
If S.Name <> FEUILLE_ACCUEIL Then S.Visible = xlSheetVeryHidden
Next S
'--- Utilisateur ET Mot de passe ---
USER$ = InputBox("Veuillez saisir votre nom d'utilisateur", "Utilisateur")
MDP$ = InputBox("Veuillez saisir votre mot de passe", "Mot de passe")
'--- Recherche correspondance ---
var = Sheets(FEUILLE_DROITS).[a1].CurrentRegion
For i& = 1 To UBound(var, 1)
If UCase(var(i&, 1)) = UCase(USER$) Then
If UCase(var(i&, 2)) = UCase(MDP) Then
NumVarLig& = i&
Exit For
End If
End If
Next i&
'--- On sort si aucune correspondance n'a été trouvée ---
If NumVarLig& = 0 Then Exit Sub
'####
Erase Autorises
For j& = 3 To UBound(var, 2)
On Error Resume Next
Err.Clear
Set S2 = Sheets(var(1, j&))
If Err = 0 Then
If LCase(var(NumVarLig&, j&)) = "oui" Then
S2.Visible = True
cpt& = cpt& + 1
ReDim Preserve Autorises(1 To cpt&)
Autorises(cpt&).Feuille = var(1, j&)
ElseIf LCase(var(NumVarLig&, j&)) <> "non" Then
S2.Visible = True
cpt& = cpt& + 1
ReDim Preserve Autorises(1 To cpt&)
Autorises(cpt&).Feuille = var(1, j&)
Autorises(cpt&).Plage = var(NumVarLig&, j&)
End If
End If
Next j&
'--- Visibilité de la feuille FEUILLE_ACCUEIL ---
Sheets(FEUILLE_ACCUEIL).Visible = Sheets(FEUILLE_DROITS).Visible
End Sub
Sub PlageAccessible(S As Worksheet, Target As Range)
Dim i&
Dim NbElements&
Dim r As Range
Dim R2 As Range
'---
If TypeName(S) <> "Worksheet" Then Exit Sub
On Error Resume Next
NbElements& = UBound(Autorises)
If NbElements& = 0 Then Exit Sub
Err.Clear
On Error GoTo 0
'---
For i& = 1 To NbElements&
If S.Name = Autorises(i&).Feuille Then
If Autorises(i&).Plage <> "" Then
Set R2 = S.Range(Autorises(i&).Plage)
Set r = Application.Intersect(Target, R2)
If r Is Nothing Then
Application.EnableEvents = False
R2.Cells(1, 1).Select
Application.EnableEvents = True
End If
End If
End If
Next i&
End Sub