XL 2013 visibilite et protection par mdp

[paskikic]

Bonsoir les Xlnautes,

j ai un dileme, j ai trouver un code vba pour proteger un classeur et mes feuilles suivant les utilisateurs mais ils faudrait que je puisse verrouiller certaines cellules sur les feuilles suivant les personnes qui les utilisent.

j explique :

je souhaite que mike est acces a la feuille 1 mais que pour les cellules B8:G10 et acces a toutes la feuilles 2 mais pas aux autres feuilles3,4,5 etc......

je vous joint un fichier avec le code que j ai trouver.

merci a vous

 

[PMO2]

Bonjour,
Une piste avec le classeur exemple joint.

1) copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_Open()
Call VisibiliteFeuilleEtPlageAutorisee
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'--- Force l'événement Workbook_SheetSelectionChange pour que la   ---
'--- sélection soit dans la première cellule de la plage autorisée ---
[a2].Offset(-1, 0).Select
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call PlageAccessible(Sh, Target)
End Sub

2) copiez le code suivant dans un module standard

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

 

[paskikic]

Salut PMO2

merci c est super

merci encore a tous le ce forum pour votre aide