Verrouiller cellules remplies à la fermeture

Pasqi

XLDnaute Junior
Bonjour,

Je voudrais un code me permettant de locker des cellules uniquement lorsque celles-ci sont remplies, mais uniquement à la fermeture du fichier, pas lors de la sauvegarde de celui-ci.
Ou pourquoi pas, à l'ouverture du fichier.

Si possible, pouvoir définir la zone des cellules devant être verrouillées (certaines, même remplies ne doivent pas être verrouillées).

Précision, j'utilise déjà un code qui protège les feuilles de ce fichier à la fermeture de celui-ci.

Je vous mets ce code en cas de nécéssité.

Sub WsLock(Optional Y)
Dim PWd$
PWd = "1234"
'Protége ou déprotège toutes les feuilles
Application.ScreenUpdating = False
If IsMissing(Y) Then
For i = 1 To Worksheets.Count
Worksheets(i).Protect PWd
[A1].Select
Next
Else
For i = 1 To Worksheets.Count
Worksheets(i).Unprotect PWd
[A1].Select
Next
End If
End Sub
Sub deprotege()
WsLock 0
End Sub
Sub protege()
WsLock
End Sub

Grand merci à vous pour votre aide.

Pasqi
 
G

Guest

Guest
Re : Verrouiller cellules remplies à la fermeture

Re bonjour Pasqi,

Utilise la balise code '#' dans la barre d'outils d'édition des message pour donner ton code. Là, cela ne donne pas envie de lire.

Code:
Sub DeverouillerCellulesVides()
    'Commence par tout vérouiller
    ActiveSheet.UsedRange.Locked = True
    'Puis dé verouillé uniquement celles qui sont vides
    On Error Resume Next
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Locked = False
End Sub

A+
 
Dernière modification par un modérateur:

Pasqi

XLDnaute Junior
Re : Verrouiller cellules remplies à la fermeture

Bonjour Hasco,

Tout d'abord merci pour ton aide et je ferai attention pour la balise (que je ne connaissais pas).

J'ai joint un fichier car je ne parvient pas à faire fonctionner ton code avec mes codes déjà existant.


Question : pour que ton code fonctionne, il faut, si je comprends bien que les feuilles soient protégées ?
Donc, le code protégeant mon fichier peut rester ??

Merci de voir si quelqu'un trouve la solution.

Bonne journée
 

Pièces jointes

  • Test protection cellules.xls
    30.5 KB · Affichages: 77
G

Guest

Guest
Re : Verrouiller cellules remplies à la fermeture

Re,

Voici ton fichier modifié.

:mad:Tu aurais pu faire au moins faire semblant d'adapter la macro que je t'ai donnée plus haut à ta situation et ne pas te contenter de la copier/coller.

C'est le genre de choses qui décourage vraiment de vous aider, nous ne sommes pas des pondeurs de macro à la demande:mad:

A+
 

Pasqi

XLDnaute Junior
Re : Verrouiller cellules remplies à la fermeture

C'est le genre de choses qui décourage vraiment de vous aider, nous ne sommes pas des pondeurs de macro à la demande:mad:

A+

Hasco,

Tout d'abord un tout grand merci pour le résultat, c'est nickel.

Je me sens un peu mal en lisant ce que tu as écrit, car mon but n'est pas de faire du copier coller et profiter du boulot d'autrui, mais je n'y comprends pas grand chose en VBE et donc, je fais ce que je peux... et donc, oui, je copie et colle quand je comprends pas et probablement que beaucoup d'autres personnes qui sont dans mon cas font la même chose.

Néanmoins, difficile de vous remercier autrement qu'avec des "merci", et sache que les mots qui me viennent pour vous, les "aidant" c'est chapeau bas, merci du temps pris pour "nous" aider, respect à vous.

Bonne journée et encore désolé si j'ai semblé avoir profité de ton travail. Ce n'était pas mon but, c'était de trouver une solution à mon problème.

Bien à toi

Pasqi
 
G

Guest

Guest
Re : Verrouiller cellules remplies à la fermeture

Re,

mais je n'y comprends pas grand chose en VBE et donc, je fais ce que je peux

Faire ce qu'on peux c'est déjà cela, mais vu ton fichier tu étais capable de faire autre choses qu'un simple copier/coller. Simplement changer le nom de la feuille par celle que tu souhaitais ou l'adresse des cellules que tu voulais. Enfin, montrer que tu avais chercher à comprendre comme cela fonctionne.

probablement que beaucoup d'autres personnes qui sont dans mon cas font la même chose.

1 - ce n'est pas une raison pour faire pareil
2 - je leur dis la même chose.

Néanmoins, difficile de vous remercier autrement qu'avec des "merci", et sache que les mots qui me viennent pour vous, les "aidant" c'est chapeau bas, merci du temps pris pour "nous" aider, respect à vous

C'est gentil, et c'est vrai que nous aimons savoir si nous ne travaillons pas pour rien.

ceci dit la meilleur façon de remercier c'est de simpliquer réellement dans l'aide de l'on demande et de progresser en essayant de comprendre.

A+ pour une nouvelle demande
 

jasol

XLDnaute Nouveau
Re : Verrouiller cellules remplies à la fermeture

Bonjour,

Je me suis inspirée des forums pour créer mon code vba pour le boulot. De la même manière que vous, la macro que j'ai créee permet de verouiller les cellules qui ont été renseignées par les utilisateurs. L'enregistrement permet de bloquer ces cellules. Le code marche très bien, néanmoins, une fois le fichier partagé, ca ne fonctionne plus, d'après mes recherches, le problème est lié à la protection des feuilles. Pouvez vous m'aidez à gérer mon problème en sachant que je suis encore novice niveau vba. Voici le code que j'ai mis :

Sub WsLock(Optional Y)
Dim PWd$
PWd = ""
Application.ScreenUpdating = False
If IsMissing(Y) Then
For i = 1 To Worksheets.Count
Worksheets(i).Protect PWd
[A1].Select
Next
Else
For i = 1 To Worksheets.Count
Worksheets(i).Unprotect PWd
[A1].Select
Next
End If
End Sub
Sub protege()
WsLock
End Sub

Sub DeverouillerCellulesVides()
'Commence par tout vérouiller
With Sheets("Sem1")
.Unprotect ""

With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem1").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem1!A1").MergeArea.Locked = False
End If
End If
Next

.Protect ""
End With
With Sheets("Sem2")
.Unprotect ""

With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem2").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem2!A1").MergeArea.Locked = False
End If
End If
Next

.Protect ""
End With
With Sheets("Sem3")
.Unprotect ""

With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem3").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem3!A1").MergeArea.Locked = False
End If
End If
Next

.Protect ""
End With
With Sheets("Sem4")
.Unprotect ""

With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem4").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem4!A1").MergeArea.Locked = False
End If
End If
Next

.Protect ""
End With


End Sub

J'ai essayé en mettant un code au début qui oblige le fichier à être en "exlusif" et à la fin qui l'oblige à être en "partagé", cela ne fonctionne pas non plus,
Quelqu'un a une idée?
 

Discussions similaires

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz