XL 2019 Figer une date si validation OK

[sum01]

Bonjour le Forum,

J'avais trouvé une macro qui correspondait presque à mon besoin. En effet, je cherche à figer une date le jour où la personne valide la cellule par OK. Or, dans le fichier ci-joint j'avais remarqué que l'exécution de la macro modifie toutes les dates y compris celles avec une validation dans le passé. C'est parce que elle se base sur AUJOURDHUI().
Comment alors modifier le code afin que seules les nouvelles validations (OK) se voient attribuer la date du jour sans toucher les valeurs passées ?
En plus, il faudrait également verrouiller les cellules qui contiennent les dates afin quelles ne puissent pas être modifiées par d'autres personnes à part l'administrateur du fichier.

Un grand merci pour votre aide
Bon week-end à vous

 

[fanfan38]

Bonjour
Dans le fichier joint on a pas la macro
A+ François

 

[wDog66]

Bonjour,

Ce serait peut-être bien de déposer le fichier avec la macro non 🤔
Sinon, il n'y a pas besoin pour moi, d'un bouton "Actualiser dates"

Il suffit d'utiliser l'évènement Change de la feuille pour mettre la date du jour quand on saisi OK

Private Sub Worksheet_Change(ByVal Target As Range)
  ' Si saisi dans la colonne E
  If Not Intersect([E:E], Target) Is Nothing Then
    ' Si saisi <> de OK, on sort
    If UCase(Target) <> "OK" Then Exit Sub
    ' Vérifier si date existe à droite, sinon l'inscrire
    If Target.Offset(0, 1) = "" Then
      ' Attention arrêter les évènements pour la modification
      Application.EnableEvents = False
      Target.Offset(0, 1) = Date
      ' Et les réactiver
      Application.EnableEvents = True
    End If
  End If
End Sub

A+

 

[sum01]

Bonjour
Dans le fichier joint on a pas la macro
A+ François

Bonjour Fanfan38, wDog66,

Etourderie de ma part qui me désole. J'ai modifié le message d'origine en postant le bon fichier avec le code.
En quoi consiste l'événement Change et comment l'utilise-t-on ?
Encore merci pour votre aide

Cordialement

 

[wDog66]

Re,

Dans VBAProject (ALT+F11) vous insérez le code donné dans la feuille en question

Sinon, je ne suis pas formateur, voici un lien

Événement Worksheet.Change (Excel)

Rubrique de référence sur Office VBA

learn.microsoft.com

 

[sum01]

Re,

Dans VBAProject (ALT+F11) vous insérez le code donné dans la feuille en question

Sinon, je ne suis pas formateur, voici un lien

Événement Worksheet.Change (Excel)

Rubrique de référence sur Office VBA

learn.microsoft.com

Bonjour wDog66,
Je ne parviens pas à exécuter le code. La macro s'arrête sur cette ligne If Not Intersect([E:E], Target) Is Nothing Then.
Je ne vois pas où est le problème.
Je vais essayer d'autres pistes. Merci quand même pour ta proposition.
Bonne soirée

 

[sum01]

ReBonjour,

Voici le code que j'ai pu récupérer et adapter. Cela fonctionne très bien. Je le partage ici pour de futures utilisations.

Bon week-end et bonne soirée


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim AdjacentCell As Range

' Vérifiez si la modification a été faite dans la colonne spécifiée (par exemple, la colonne A)
If Not Intersect(Target, Me.Range("E:E")) Is Nothing Then
Application.EnableEvents = False
For Each Cell In Intersect(Target, Me.Range("E:E"))
If Cell.Value = "ok" Then
Set AdjacentCell = Cell.Offset(0, 1)
If IsEmpty(AdjacentCell) Then
AdjacentCell.Value = Date
AdjacentCell.Locked = True
End If
End If
Next Cell
Application.EnableEvents = True
End If
End Sub