Verrouillage cellules après saisie

**Meuse55** · 20/02/2013, 08h44

Bonjour,

je fais un tableau qui sera utilisé par plusieurs personnes, afin d'éviter tout effacement involontaire, j'aimerai qu'une ligne complète soit verrouillée après la saisie d'une date dans une des cellules.

En gros, mon utilisateurs remplit l'ensemble des informations, il termine en indiquant la date de son enregistrement ce qui verrouille la ligne complète pour éviter toute nouvelle saisie dessus.

Est-ce possible?

**NEC14** · 20/02/2013, 09h03

Bonjour,

On va faire plus général : si une cellule contient une formule elle n'est pas déverrouillée : (à adapter selon tes besoins)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Const nbcol As Long = 10 
    Dim col As Long 
    'activation protection générale 
    If Target = [A1] And [A1] = "" Then ActiveSheet.Unprotect 
    ' protection des lignes 
    If Target.Column = 1 And Target.Row > 1 Then 
        ActiveSheet.Unprotect 
        If LCase(Target) = "x" Then 
            Target.Offset(0, 1).Resize(1, nbcol).Locked = True 
        Else 
            For col = 1 To nbcol 
                If Left(Target.Offset(0, col).Formula, 1) <> "=" Then Target.Offset(0, col).Locked = False 
            Next col 
        End If 
    End If 
    If [A1] = "x" Then ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
End Sub

Testes ce code et tiens nous au courant

**Meuse55** · 20/02/2013, 09h27

Merci pour cette réponse.

J'avoue mon incompétence complète à adapter ce code à ma situation. Je débute totalement et suis perdue.

Puis-je mettre en pièce jointe le tableau pour une meilleure vision?

**NEC14** · 20/02/2013, 09h41

Bien au contraire, avec un fichier joint c'est plus facile.

**Meuse55** · 20/02/2013, 09h53

Le voici donc en pièce jointe. je voudrais pouvoir remplir chacune de mes cellules et à partir du moment où une date est saisie dans la cellule S, la ligne est verrouillée. Possible?

Merci beaucoup.

**keygen08** · 20/02/2013, 10h15

Bonjour

au plus simple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
    If Range("s" & Target.Row).Text <> "" Then
        Target.EntireRow.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
End Sub

Il faut savoir que la protection des cellule n'est effective que si la feuille elle meme est protegée.
J'ai donc sur ton fichier, déprotéger toutes les cellules, reproteger les lignes qui ne doivent pas etre modifié.
Par la suite, losque je modifie la valeur de cellule S, la macro s'applique est verrouille la ligne qui vient d'être écrite.
Je ne joint pas le fichier car je pense que @NEC vas te soigner cela au petit oignon.

**Meuse55** · 20/02/2013, 10h28

c'est gentil merci. J'aime comprendre et apprendre, alors je teste ça quand même de mon côté^^

Je viens de tester le code, c'est exactement ce que je voulais et ça fonctionne à merveille!! Merci!

**NEC14** · 20/02/2013, 11h02

Voilà je crois avoir résolu le problème

**keygen08** · 20/02/2013, 11h12

La saisie d'une donnée en colonne S entraine la protection de la ligne
Toute modification ultérieure dans une ligne ou la cellule S est rempli doit se faire en deprotegant la feuille.
On pourrai ajouter un controle de la valeur saisi en S de façon a ce qu'il n'y est qu'une date qui puisse être saisi.

**NEC14** · 20/02/2013, 11h18

Oui tu as raison, cela pourrait être une sécurité supplémentaire.
Je regarde ça.

**NEC14** · 20/02/2013, 11h44

Apparamenent c'est déjà le cas, cr lorsque l'on saisi autre chose qu'une date, un message apparaît.

**Meuse55** · 20/02/2013, 13h53

Merci à tous les deux. J'ai normalement fait apparaître un message pour imposer l'entrée d'une date postérieure au 01/01/2013.

**NEC14** · 20/02/2013, 14h21

Eh bien c'est super !

Si ton problème est résolu n'oublie pas de cliquer sur "Résolu"
A+

**Meuse55** · 21/02/2013, 13h54

Arf, ça fonctionnait bien hier et là ce matin j'ai une erreur "espace pile insuffisant" qui fait tout planter. Il semblerait que ce soit dû au fait que j'ai ajouté la mise en majuscule automatique sur 2 cellules, mon code donne ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F1:F1000")) Is Nothing Then Target = UCase(Target)
    If Not Intersect(Target, Range("K1:K1000")) Is Nothing Then Target = UCase(Target)
ActiveSheet.Unprotect
    If Range("s" & Target.Row).Text <> "" Then
        Target.EntireRow.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End If
End Sub