Re : Verrouillage de la ligne saisie par mot de passe
Salut le forum,
Je reprends le fil après test sur test depuis midi.
Incompréhensible, j'ai le code suivant qui fonctionne sur une feuille et lorsque je le copie sur la feuille cible la macro ne fonctionne plus correctement :
Après avoir triée et enregistrée une ligne, je n'ai accès à la saisie sur la ligne suivante qu'après avoir déverouillé le mot de passe dans outils--> oter la protection. C'est vrai pour le fichier cible et pas pour le fichier initial.
Est ce que l'ordre des feuilles a une importance code feuil1 copier vers code feuil2?
il faudrait que la protection ne soit active que sur les lignes triées, enregistrees avec la date d'enregistrement :sur toutes les autres lignes, l'acces ne doit pas etre protégé.
Voici le code : Si quelqu'un peut m'aider, ce serait sympa!!!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lig As Long, SetRep, VColD, VColL
'
' Vérifie si la saisie en dehors des colonnes de A à N
' On sort de la procédure
If Intersect(Target, Range("A2:N65536")) Is Nothing Then Exit Sub
' récupère la Saisie dans la colonne de D ou L
Lig = Target.Row
VColD = Range("D" & Lig).Value
VColL = Range("L" & Lig).Value
If VColL <> 0 And VColD <> 0 Then
SetRep = MsgBox("Validez votre saisie :Attention,vous ne pourrez plus modifier la ligne après la validation ", vbYesNo)
End If
' Quelle réponse de l'utilisateur
If SetRep = 6 Then
' Désactive les évènements dans le classeur
Application.EnableEvents = False
If Range("N" & Lig).Value = "" Then
Range("N" & Lig).Value = "Enregistré"
End If
'Déprotège le classeur
ActiveSheet.Unprotect Password:="toto"
With Range("A" & Target.Row & ":N" & Target.Row)
.Locked = True
.FormulaHidden = True
End With
'Inscrit la date et heure de saisie si n'existe pas déjà
If Range("N" & Lig).Value <> 0 Then
If Range("M" & Lig).Value = "" Then 'And Target.Value <> "" Then
' Inscrit la date
Range("M" & Lig).Value = Now()
End If
End If
'Supprimer lignes vides
Dim n As Integer
Dim x As Integer
Dim Plein As Boolean
For n = Range("A65536").End(xlUp).Row To 2 Step -1
For x = 1 To 11
If Cells(n, x) <> "" Then Plein = True
Exit For
Next x
If Plein = False Then Rows(n).Delete
Plein = False
Next n
' Tri des données sur 3 colonnes
Range("A2:M65000").Sort key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("A2"), _
Order2:=xlAscending, key3:=Range("E2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="toto"
' Réactive les évènements dans le classeur
Application.EnableEvents = True
'Enregistre le classeur
ActiveWorkbook.Save
End If
End Sub
Je profite de ce message pour remercier chaleureusement BrunoM45 et Banzai64 pour l'aide précieuse qu'ils m'ont tous les deux apportés pour realiser ce programme qui touche a sa fin.
Cordialement
dss