Verrouiller fichier excel en gardant les cellules

passable Messages postés 157 Date d'inscription   Statut Membre Dernière intervention   -  
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
J'ai un fichier excel avec plusieurs onglets correspondants aux mois de l'année.

Je souhaiterais verrouiller/déverrouiller tout le fichier en une seule fois en gardant certaines cellules modifiables, comme lorsque je verrouille individuellement chaque onglet.

J'ai trouvé une macro qui verrouille tout le fichier en une fois. Sauf qu'il est alors impossible de modifier quoi que ce soit (même si la cellule n'est pas verrouillée)

Sub protect_all_sheets()
top:
pass = InputBox("password?")
repass = InputBox("Verify Password")
If Not (pass = repass) Then
MsgBox "you made a boo boo"
Goto top
End If
For i = 1 To Worksheets.Count
If Worksheets(i).ProtectContents = True Then Goto oops
Next
For Each s In ActiveWorkbook.Worksheets
s.Protect Password:=pass
Next
Exit Sub
oops: MsgBox "I think you have some sheets that are already protected. Please unprotect all sheets then running this Macro."
End Sub

Quelqu'un aurait-il une solution svp?

Merci!
A voir également:

2 réponses

Réponse 1 / 2
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   231
 
Bonjour,

Je viens d'essayer. Je peux modifier les cellules déverrouillées. Ce pendant, si tu as déjà protégé la feuille en interdisant la sélection des cellules déverrouillées, la macro reprend ce que tu as déjà mis.

Essaie : 

Sub protect_all_sheets()
top:
pass = InputBox("password?")
repass = InputBox("Verify Password")
If Not (pass = repass) Then
MsgBox "you made a boo boo"
GoTo top
End If
For i = 1 To Worksheets.Count
If Worksheets(i).ProtectContents = True Then GoTo oops
Next
For Each s In ActiveWorkbook.Worksheets
s.Protect Password:=pass
s.EnableSelection = xlUnlockedCells
Next
Exit Sub
oops: MsgBox "I think you have some sheets that are already protected. Please unprotect all sheets then running this Macro."
End Sub


Daniel
0
passable Messages postés 157 Date d'inscription   Statut Membre Dernière intervention   6
 
Des génies je vous dit! Ca fonctionne, merci bcp!
0
Réponse 2 / 2
titeufdu89 Messages postés 374 Date d'inscription   Statut Membre Dernière intervention   38
 
Bonjour,

Essaye ce code, à coller dans un module : 

Option Explicit

Sub proteger()
Dim pass, repass As String
top:
pass = InputBox("password?")
repass = InputBox("Verify Password")
If Not (pass = repass) Then
MsgBox "you made a boo boo"
GoTo top
End If

Dim ws As Worksheet
Dim i As Integer

For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
    If Worksheets(i).Protect = False Then
    Worksheets(i).Protect pass, DrawingObjects:=True, Contents:=True, Scenarios:=True
    Worksheets(i).EnableSelection = xlUnlockedCells
    End If
Next i
End Sub


Bonne journée

Jc
0
passable Messages postés 157 Date d'inscription   Statut Membre Dernière intervention   6
 
Bonjour,
A priori la solution de Daniel fonctionne. Le seul problème, c'est comment tout déverrouiller en une fois (je n'ai pas les droits administrateurs pour télécharger des solutions... mais je peux installer des macros!). Merci
0
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   231
 
Tu remplaces les lignes que tu as affichées par les miennes et tu enregistres le fichier.

Daniel
0
passable Messages postés 157 Date d'inscription   Statut Membre Dernière intervention   6 > danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Daniel,
Ca fonctionne en effet. En revanche, comment je déverrouille tout en une fois?
Merci
0
danielc0 Messages postés 1859 Date d'inscription   Statut Membre Dernière intervention   231
 
Bonjour,

Ajoute cette macro : 
Sub DeprotegerTout()
top:
  pass = InputBox("password?")
  repass = InputBox("Verify Password")
  If Not (pass = repass) Then
  MsgBox "you made a boo boo"
  GoTo top
  End If
  For i = 1 To Worksheets.Count
    Worksheets(i).Unprotect pass
  Next i
End Sub


Daniel
0