XL 2010 bloquer cellule

[eastwick]

Bonjour à toutes et tous,

Je souhaiterais bloquer les cellules des colonnes Q et V à partir de la ligne 9 à partir du moment où elle ont un contenu. Une date colonne Q et la mention "Vu" pour la V.
Y inclure la possibilité de se rétracter avec une macro où un mot de passe.

En vous remerciant !

 

[Laurent78]

Bonjour,
hum hum hum, ne manquerait-il pas quelque chose ? un fichier par exemple
De rien
Laurent

 

[eastwick]

J'en ai fait un vite fait. Je ne pensais pas qu'il soit d'une utilité quelconque...
Merci

 

[job75]

Bonjour eastwick, Laurent78,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal R As Range)
Dim mem
Protect "toto", UserInterfaceOnly:=True 'feuille protégée
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Intersect(Range("Q9:Q" & Rows.Count), UsedRange)
    .Locked = False 'déverrouille
    mem = .Value
    .Replace "*/*", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    .SpecialCells(xlCellTypeConstants, 16) = mem
End With
With Intersect(Range("V9:V" & Rows.Count), UsedRange)
    .Locked = False 'déverrouille
    .Replace "Vu", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    .SpecialCells(xlCellTypeConstants, 16) = "Vu"
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

A+

 

[eastwick]

Merci beaucoup... Ce groupe m'aide depuis des années. Je ne soulignerais jamais assez son immense utilité.

 

[eastwick]

Subsiste juste le souci de la date qui m'impose le 31/07/2019 si elle est saisie plus bas que juste sous la dernière date saisie. Merci.

 

[job75]

J'avais fait une erreur, voyez ce fichier (2) avec restitution par .Value = mem :

Private Sub Worksheet_Change(ByVal R As Range)
Dim mem
Protect "toto", UserInterfaceOnly:=True 'feuille protégée
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Intersect(Range("Q9:Q" & Rows.Count), UsedRange)
    mem = .Value
    .Locked = False 'déverrouille
    .Replace "*/*", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    .Value = mem
End With
With Intersect(Range("V9:V" & Rows.Count), UsedRange)
    .Locked = False 'déverrouille
    .Replace "Vu", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    .SpecialCells(xlCellTypeConstants, 16) = "Vu"
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

 

[eastwick]

Pas de souci, encore merci, ça fonctionne parfaitement.

 

[job75]

Pour tester j'ai recopié la plage Q9:V39 sur 62 000 lignes.

Avec la macro précédente l'exécution se fait en 5 secondes quelle que soit la modification, c'est trop long.

Voyez ce fichier (3) et cette macro, l'exécution est en général immédiate :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, i&, mem
Protect "toto", UserInterfaceOnly:=True 'feuille protégée
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Intersect(Target, Range("Q9:Q" & Rows.Count), UsedRange)
    Set P = .Areas(1)
    For i = 2 To .Areas.Count
        Set P = Range(P, .Areas(i)) 'concatène les zones disjointes
    Next
    mem = P
    P.Locked = False 'déverrouille
    P.Replace "*/*", "#N/A", xlWhole
    P.SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    P = mem
End With
With Intersect(Target, Range("V9:V" & Rows.Count), UsedRange)
    .Locked = False 'déverrouille
    .Replace "Vu", "#N/A", xlWhole
    .SpecialCells(xlCellTypeConstants, 16).Locked = True 'verrouille
    .SpecialCells(xlCellTypeConstants, 16) = "Vu"
End With
Application.EnableEvents = True 'réactive les évènements
End Sub