Accueil

La protection d'une feuille Protéger/Déprotéger par programme Protection des formules par VBA Raz zones déverrouillées Protection réseau sans VBA Protection en réseau en VBA

-Attributtion d'une zone à chaque utilisateur -Protection de champs en fonction du user -Une feuille par utilisateur -Plusieurs feuilles par utilisateur -Mot de passe -Protection anti macros -Utilisation classeurs 30 jours -Protection lecture seule -Mot de passe avec 3 tentatives -Protection date

Protect Unprotect UserInterfaceOnly

Protection d'une feuille

Pour empêcher la destruction intempestive des formules d'un tableau:
-Sélectionner les zones de saisie (B2:E2) et B4:E6
-Format/Cellule/Protection
-Décocher Verrouillée
-Outils/Protection/Protéger la feuille

Protéger/Déprotéger par programme

Protect Password:="xxx"
Unprotect Password:="xxx"

Permet de protéger et déprotéger une feuille.

Sheets(1).Unprotect Password:="jacques"
[A1]="Coucou"
Sheets(1).Unprotect Password:="jacques"

Userinterfaceonly

L'option userinterfaceonly:=True permet de modifier par VBA les cellules protégées.

Sub auto_open()
    Sheets(1).Protect Password:="moi", userinterfaceonly:=True
   [A1] = "coucou"
End Sub

La fonction ci dessous indique si la feuille est protégée

FonctionProtection

Function protection()
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  protection = IIf(f.ProtectContents, "protégé", "Non protégé")
End Function

Protection des formules et les libellés d'un classeur par VBA

Sub ProtegeFormulesEtConstantesTexte()
  For Each s In ActiveWorkbook.Sheets
    s.Unprotect Password:=""
    s.Cells.Locked = False
    On Error Resume Next
    s.Cells.SpecialCells(xlCellTypeFormulas, 23).Locked = True
    s.Cells.SpecialCells(xlCellTypeConstants, 2).Locked = True
    On Error GoTo 0
    s.Protect Password:=""
   Next s
End Sub

Raz des zones déverrouillées

-Enlever le verrouillage sur les cellules de saisie avec Format/Cellule/Protection
-Protéger la feuille avec Outils/Protection/Protéger la feuille

Alt+F11 puis Insertion/Module -ProtectionRaz -

Sub raz()
  ActiveSheet.Unprotect Password:="moi"
  For Each c In Cells.SpecialCells(xlCellTypeConstants, 23)
    If c.Locked = False Then c.Value = Empty
  Next c
  ActiveSheet.Protect Password:="moi"
  ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

Une fonction pour afficher l'état de la protection d'une feuille

Function protection()
  Application.Volatile
  Set f = Sheets(Application.Caller.Parent.Name)
  protection = f.ProtectContents
End Function

Dans une cellule =Protection()

Fonction Protection

Protection en réseau sans VBA(2002+)

Pour réserver des zones en écriture à des utilisateurs, utiliser les commandes

-Outils/Protection/Permettre aux utilisateurs
-Définir des mots de passe pour chaque champ
-Outils/protéger la feuille

Pour partager un classeur en réseau

-Outils/Partage du classeur

- Classeur protégé -

Protection multi-utilisateurs en réseau par VBA

Exemple1:Chaque utilisateur ne peut modifier que le champ qui correspond à son nom

Créer des noms de champ qui correspondent aux noms d'utilisateur réseau. Scrollarea=champ restreint l'accés au champ prévu pour chaque utilisateur.

Protection Multi Champs ScrollArea
Protection Multi Champs ScrollArea mot passe

Private Sub Workbook_Open()
  On Error Resume Next
  Sheets(1).ScrollArea = Environ("username")
  If Err <> 0 Then Sheets(1).ScrollArea = "invite"
End Sub

Exemple2: Seuls les utilisateurs prévus peuvent sélectionner les champs jaunes

Il n'y a pas de mot de passe. On s'appuie sur les noms d'utilisateurs réseau.

ProtectionMultiUser
ProtectionMultiUser2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Union([champ1], [champ2], [champ3]), Target) Is Nothing Then
    If Environ("username") <> "Boisgontier" _
      And Environ("username") <> "Dupont" Then [A1].Select
    End If
End Sub

Exemple3: Visualise la feuille de l'utilisateur(nom réseau)

Une feuille est affectée à chaque utilisateur. A la sauvegarde du classeur, on masque toutes les feuilles. A l'ouverture, on affiche seulement celle de l'utilisateur .
Chaque feuille doit avoir pour nom le nom de l'utilisateur réseau. -ProtectionOngletSimple -

Private Sub Workbook_Open()
  Sheets(Environ("username")).Visible = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For s = 2 To Sheets.Count ' on masque les feuilles
  Sheets(s).Visible = xlVeryHidden
Next s
End Sub

Exemple3Bis: Visualise la(les) feuille(s) de l'utilisateur

A chaque utilisateur, il est attribué plusieurs feuilles. La feuille Admin contient pour chaque utilisateur la
liste des feuilles qui lui sont attribuées. -ProtectionOngletMultiFeuilles -

Private Sub Workbook_Open()
  For i = 1 To Range("user").Count
    If UCase(Environ("username")) = UCase(Range("user")(i)) Then
       temp = Range("feuille")(i)
       Sheets(temp).Visible = True
    End If
  Next i
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   For s = 2 To Sheets.Count ' on masque les feuilles
     Sheets(s).Visible = xlVeryHidden
   Next s
End Sub

Exemple4:Visualise la(les) feuille(s) de l'utilisateur en fonction du mot de passe

A chaque utilisateur, il est attribuéplusieurs feuilles. La feuille Admin contient pour chaque utilisateur la
liste des feuilles qui lui sont attribuées.

ProtectionOngletMultiFeuillesMP

Un UserForm demande le mot de passe:

Private Sub B_ok_Click()
  If Me.motpasse <> "" Then
  For i = 1 To Range("MotPasse").Count
    If UCase(Me.motpasse) = UCase(Range("motpasse")(i)) Then
      temp = Range("feuille")(i)
      Sheets(temp).Visible = True
    End If
  Next i
  End If
  Unload Me
End Sub

Dans un Module

Sub auto_open()
  UserForm1.Show
End Sub

Sub AfficheTousOnglets()
  For Each s In ActiveWorkbook.Sheets
    s.Visible = True
  Next s
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   For s = 2 To Sheets.Count ' on masque les feuilles
     Sheets(s).Visible = xlVeryHidden
   Next s
End Sub

Sur la version ci dessous, on demande un nom d'utilisateur et un mot de passe

Protection Onglet MultiFeuilles Utilisateur MP

Dim f, NbEssai
Private Sub UserForm_Initialize()
  Set f = Sheets("Admin")
  Me.Utilisateur.List = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value
End Sub

Private Sub B_ok_Click()
  util = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value
  mp = f.Range("b2:b" & f.[A65000].End(xlUp).Row).Value
  feuille = f.Range("C1").Resize(1, f.[iv1].End(xlToLeft).Column - 2).Value
  droits = f.Range("C2").Resize(f.[A65000].End(xlUp).Row - 1, f.[iv1].End(xlToLeft).Column - 2).Value
  If Me.motpasse <> "" And Me.Utilisateur <> "" Then
     NbEssai = NbEssai + 1: Me.Label3.Caption = "Erreur! " & NbEssai & " essai(s)"
    For i = 1 To UBound(util)
      If UCase(Me.motpasse) = UCase(mp(i, 1)) And UCase(Me.Utilisateur) = UCase(util(i, 1)) Then
        For j = 1 To UBound(feuille, 2)
           If droits(i, j) = "X" Then Sheets(feuille(1, j)).Visible = True
        Next j
        Sheets("Espion").[M2] = Me.Utilisateur
        Unload Me: Exit Sub
      End If
   Next i
   End If
   If NbEssai > 3 Then
     MsgBox "Erreur MP! " & NbEssai & " essai(s)!"
     ThisWorkbook.Close False
   End If
End Sub

Private Sub Workbook_Open()
  Sheets("espion").[A65000].End(xlUp).Offset(1, 0) = Now
  Sheets("espion").Visible = xlVeryHidden
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
  Sheets("espion").[A65000].End(xlUp).Offset(0, 1) = Now
  Sheets("espion").[A65000].End(xlUp).Offset(0, 2) = Sheets("Espion").[M2] 'Environ("username")
  Sheets("espion").[A65000].End(xlUp).Offset(0, 3) = Environ("computername")
  Sheets("espion").Visible = xlVeryHidden
  For s = 2 To Sheets.Count ' on masque les feuilles
     Sheets(s).Visible = xlVeryHidden
  Next s
End Sub

Exemple5:Si les macros ne sont pas activées, les feuilles de travail ne sont pas visibles

A la sauvegarde du classeur, nous masquons tous les onglets du classeur.
Si à l'ouverture du classeur, les macros ne sont pas activées, les pages ne seront pas visibles.
-ProtectionAntiMacros -

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  For s = 2 To Sheets.Count ' on masque les feuilles
    Sheets(s).Visible = xlVeryHidden
  Next s
End Sub

Private Sub Workbook_Open()
  For s = 2 To Sheets.Count
    Sheets(s).Visible = True
  Next s
End Sub

Protection date

ProtectionDate

On ne peut pas sélectionner une cellule si la date du jour est supérieure à la date de clôture.

Le fichier est utilisable pendant 30 jours

Après un délai de 30 jours, l'opérateur ne peut plus visualiser l'onglet utilisateur.

Protection30Jours

Private Sub Workbook_Open()
  If Sheets("secret").[A1] = "" Then
    Sheets("secret").[A1] = Date + 30
    MsgBox "Valable jusqu'au " & Sheets("secret").[A1]
    Sheets("secret").visible = xlVeryHidden
    ActiveWorkbook.Save
  Else
    If Date > Sheets("secret").[A1] Then
      Sheets("utilisateur").visible = xlVeryHidden
      MsgBox "expiré"
      ActiveWorkbook.Save
      ActiveWorkbook.Close
    End If
  End If
End Sub

Autre version

AutoDestuct30Jours

Private Sub Workbook_Open()
  If Sheets("secret").[A1] = "" Then
    Sheets("secret").[A1] = Date + 30
    MsgBox "Valable jusqu'au " & Sheets("secret").[A1]
    Sheets("secret").Visible = xlVeryHidden
    Sheets("Utilisateur").Visible = True
    ActiveWorkbook.Save
  Else
    If Date > Sheets("secret").[A1] Then
      Sheets("utilisateur").Visible = xlVeryHidden
      MsgBox "Expiré!"
      ActiveWorkbook.ChangeFileAccess xlReadOnly
      Kill ActiveWorkbook.FullName
      ActiveWorkbook.Close False
    Else
      MsgBox "Expire le " & Sheets("secret").[A1]
    End If
  End If
End Sub

Si l'utilisateur n'appartient pas à la liste des utilisateurs, le fichier est en lecture seule

ProtectionLectureSeule

Liste utilisateurs
Boisgontier
Dupont

La liste des utilisateurs est dans un onglet caché (xlveryhidden) et donc invisible.

Private Sub Workbook_Open()
  nom = Environ("username")
  Set temp = [utilisateurs].Find(what:=nom)
  If temp Is Nothing Then
    ActiveWorkbook.ChangeFileAccess xlReadOnly
  End If
End Sub

Le fichier devient inutilisable après 3 essais de mot de passe
(on masque les feuilles)

MotPasse

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  For s = 2 To Sheets.Count ' on masque les feuilles
    Sheets(s).Visible = xlVeryHidden
  Next s
End Sub

Private Sub Workbook_Open()
  If Sheets(2).Name = "HS" Then
     MsgBox "HS!"
     ActiveWorkbook.Close
   End If
   F_motPasse.Show
End Sub

Dim essai
Private Sub B_ok_Click()
   If Me.MotPasse = "jacques" And essai <= 3 Then
      For s = 2 To Sheets.Count ' on affiche les feuilles
          Sheets(s).Visible = True
      Next s
      Unload Me
   Else
      Me.MotPasse = ""
      essai = essai + 1
      Me.MotPasse.SetFocus
      MsgBox essai & "e essai!"
      If essai = 3 Then
      Sheets.Add after:=Sheets(1)
      Sheets(2).Name = "HS"
      Sheets(1).Select
      Sheets(1).Range("B24") = "HS! "
      Sheets(1).Range("B25") = "Tentative accès de " & Environ("username") & " le " & Now
      Sheets(2).Visible = xlVeryHidden
      ActiveWorkbook.Save
      ActiveWorkbook.Close
    End If
  End If
End Sub