Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Y1:Y1000")) Is Nothing Then 'Valable seulement pour la Plage Y1:Y120
'Suppression de la protection de la feuille
ActiveSheet.Unprotect
If Range("y" & Target.Row).Text <> "" Then
Target.EntireRow.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub
Bonjour herve62Bonjour
Je comprends pas bien le détail ?
Est ce qu'il faut protéger des blocs (comme A à K) puis L N ..etc ?
Ensuite tu dis : après saisie ? ok mais pour ressaisir plus tard il faudra déverrouiller
comme cela se fait par code avec détection de la zone je ne vois pas l'intérêt ? je ne vois pas bien
Sinon oui c'est avec ce type de code on limite des zones de sélection et on fait l'action
Précise plus ta démarche
Re herve62Bon une idée de début
il faut d'abord agir sur les feuilles
Sur chaque zone concernée ( j'ai fait de A à K) décocher "verrouillé" dans le format cellules
Puis protéger la feuille en ne laissant que : autoriser pour les cellules déverrouillé
Enfin l'exemple de code fonctionne chez moi
On pourra ajouter un MdP par utilisateur par exemple avec inputbox ..etc
peut être ai je oublié de déverrouiller ?cela marche en effet (Sauf les lignes 6 et 7 que j'avais testé hier)
Bonjour @nobodyuse
Oui conditionné par K , mais juste dernière ligne et si vide à K + 1
En fait il faut que ce soit le dernier "Change" ..mais peut être que tu dois encore entrer quelque chose ailleurs ?
Pour les autres zones ...simple tu mets autant de blocs "Intersect" pour tes différentes zones
N'oublie pas de décocher tes cellules > "Verrouillé"
peut être ai je oublié de déverrouiller ?
Pour l'accès conditionné aux utilisateurs : tu donnes un MdP à chaque groupe puis tu le teste dans le code avec un inputBox ensuite avec un selectCase tu affectes la portion de macro qui donne leur zone d'accès (A:K ...etc)
Bonjour @nobodyuse
Oui conditionné par K , mais juste dernière ligne et si vide à K + 1
En fait il faut que ce soit le dernier "Change" ..mais peut être que tu dois encore entrer quelque chose ailleurs ?
Pour les autres zones ...simple tu mets autant de blocs "Intersect" pour tes différentes zones
N'oublie pas de décocher tes cellules > "Verrouillé"
peut être ai je oublié de déverrouiller ?
Pour l'accès conditionné aux utilisateurs : tu donnes un MdP à chaque groupe puis tu le teste dans le code avec un inputBox ensuite avec un selectCase tu affectes la portion de macro qui donne leur zone d'accès (A:K ...etc)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 And Target.Row > 1 Then Target.Offset(0, 4).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date)
If Target.Column = 12 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date)
If Target.Column = 15 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date)
If Target.Column = 18 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date)
If Target.Column = 19 And Target.Row > 1 Then Target.Offset(0, 2).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date + 365)
If Not Intersect(Range("K1:K100"), Target) Is Nothing Then
dl = Range("k100").End(xlUp).Row
If Cells(dl + 1, 11) = "" Then
ActiveSheet.Unprotect
Range("A" & dl & ":K" & dl).Locked = True
ActiveSheet.Protect
End If
If Not Intersect(Range("N1:N100"), Target) Is Nothing Then
dl = Range("N100").End(xlUp).Row
If Cells(dl + 1, 11) = "" Then
ActiveSheet.Unprotect
Range("L" & dl & ":N" & dl).Locked = True
ActiveSheet.Protect
End If
End If
End If
End Sub
Voici le fichier en attachement :/J'ai voulu commencer le travail a defaut de trouver comment conditionner a la selection de "OUI" dans la colonne Valid
mais en ajoutant un block "Intersect" de la meme facon que toi
VB:Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 7 And Target.Row > 1 Then Target.Offset(0, 4).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date) If Target.Column = 12 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date) If Target.Column = 15 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date) If Target.Column = 18 And Target.Row > 1 Then Target.Offset(0, 1).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date) If Target.Column = 19 And Target.Row > 1 Then Target.Offset(0, 2).Value = IIf(Target.Value = "" Or IsEmpty(Target), Empty, Date + 365) If Not Intersect(Range("K1:K100"), Target) Is Nothing Then dl = Range("k100").End(xlUp).Row If Cells(dl + 1, 11) = "" Then ActiveSheet.Unprotect Range("A" & dl & ":K" & dl).Locked = True ActiveSheet.Protect End If If Not Intersect(Range("N1:N100"), Target) Is Nothing Then dl = Range("N100").End(xlUp).Row If Cells(dl + 1, 11) = "" Then ActiveSheet.Unprotect Range("L" & dl & ":N" & dl).Locked = True ActiveSheet.Protect End If End If End If End Sub
Cela ne fonctionne plu
je doit merder quelques part
Merci herve62, Pas de soucisvite fait , je regarde ce soir
tes blocs iF sont mal placés , il faut d'abord clore les INTERSECT !!!!
là tu testes un intersect (N1:N100) INCLU dans le 1er ??? met END IF avant !!!
Private Sub Workbook_Open()
Dim mdp$
With Feuil3 'CodeName de la feuille
mdp = InputBox("Entrez votre mot de passe :")
Select Case mdp
Case "TATA": Application.Goto .[A1], True: .[A4].Select: .ScrollArea = "A4:L" & Rows.Count
Case "TITI": Application.Goto .[M1], True: .[M4].Select: .ScrollArea = "M4:P" & Rows.Count
Case "TOTO": Application.Goto .[Q1], True: .[Q4].Select: .ScrollArea = "Q4:T" & Rows.Count:
Case "TUTU": Application.Goto .[U1], True: .[U4].Select: .ScrollArea = "U4:X" & Rows.Count
Case Else: Application.Goto .[A1]: .ScrollArea = "A1"
End Select
End With
End Sub
Bonjour Job75Bonjour nobodyuse, herve62,
S'il s'agit d'autoriser l'accès aux plages par mots de passe placez dans ThisWorkbook :
Bien entendu il faudra protéger l'accès au VBAProject par un mot de passe.VB:Private Sub Workbook_Open() Dim mdp$ With Feuil3 'CodeName de la feuille mdp = InputBox("Entrez votre mot de passe :") Select Case mdp Case "TATA": Application.Goto .[A1], True: .[A4].Select: .ScrollArea = "A4:L" & Rows.Count Case "TITI": Application.Goto .[M1], True: .[M4].Select: .ScrollArea = "M4:P" & Rows.Count Case "TOTO": Application.Goto .[Q1], True: .[Q4].Select: .ScrollArea = "Q4:T" & Rows.Count: Case "TUTU": Application.Goto .[U1], True: .[U4].Select: .ScrollArea = "U4:X" & Rows.Count Case Else: Application.Goto .[A1]: .ScrollArea = "A1" End Select End With End Sub
Je n'ai pas compris ce que vous voulez faire avec les OUI.
A+