XL 2016 Uniformiser la date des cellules

[Phylo]

Bonjour

J 'ai crée un fichier excel qvec un code vba qui incorpore la date automatiquement
Mais vu que le fichier est utilisé par plusieurs personne. La date entrée est variable selon la date d' ordi de chaque personne

je veux insérer l'instruction dans ce code

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Columns("J")) Is Nothing And Target.Value <> "" Then
Target.Offset(0, 1).Value = Date & " " & Time
End If

'Dans les colonnes I et K la format de la date est : dd-mm-yyyy
exemple :
Columns()Numberformat="dd-mm-yyyy"


Merci d'avance

 

[Dranreb]

Ben la 2ème ! Inutile de la mettre 2 fois !

 

[Phylo]

le code n'a pas encore marché

j'ai changé la configuration a tous le monde mais malgré ça

 

[Dranreb]

Joignez le classeur.
Normalement ça devrait marcher.
Et vous n'avez pas mis les Application.EnableEvents = False puis True ?
À chaque fois que vous mettez cette date ça la ré-exécute. Est-ce que ça ne le contrecarre pas ?
Normalement non si vous avez bien indiqué toute la procédure. Mais c'est un principe: ne jamais changer de cellule dans une Sub WorkSheet_Change sans avoir préalablement exécuté Application.EnableEvents = False. C'est un coup à saturer la pile des appels.

 

[Phylo]

voici le fichier
Merci de m'intégrer le code stp
Merci bcp

 

[Dranreb]

Ce n'est pas tout à fait la même chose.
J'ai eu la surprise de le voir interpréter Now alors que c'était déjà une date et une heure.
J'ai dû utiliser Value2 pour l'obliger à prendre ce que je lui mets, un point c'est tout !
Ça se rapproche là ? :

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Me.ListObjects(1).DataBodyRange, Target) Is Nothing Then Exit Sub
   If Not Intersect([J:J,L:L,N:N,S:S,U:U,W:W], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy h:mm": .Value2 = Now: End With
      If Not Intersect([J:J,S:S], Target) Is Nothing Then
         With Target.Offset(0, -1)
            .NumberFormat = "m/d/yyyy h:mm": .Value2 = Now + 2: End With
         End If
      Application.EnableEvents = True
   ElseIf Target.Column = 2 Then
      Dim Cel As Range
      Set Cel = Sheets("Mes listes").Columns(1).Cells.Find(what:=Target.Value, LookAt:=xlWhole)
      If Not Cel Is Nothing Then
         Application.EnableEvents = False
         Target.Offset(0, 1).Value = Cel.Offset(0, 1).Value
         Application.EnableEvents = True
         End If
      End If
   End Sub

 

[Phylo]

Merci bcp C'est génial
Oui effective,ent c'est un ancien fichier avec la fonction now maintenant j'ai mis date et ça marche merveille

Bien a toi

 

[Phylo]

Je veux pas d'indépendance des colonnes
si je rempli par exemple J et il remplie K et M

je veux comme c'était séparé
j'ai essayé ce code mais ne marche pas

 Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Me.ListObjects(1).DataBodyRange, Target) Is Nothing Then Exit Sub
   If Not Intersect([J:J], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
  If Not Intersect([L:L], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
 If Not Intersect([N:N], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With

 If Not Intersect([S:S], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
 If Not Intersect([U:U], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
If Not Intersect([W:W], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
If Not Intersect([J:J], Target) Is Nothing Then
         With Target.Offset(0, -1)
            .NumberFormat = "m/d/yyyy": .Value2 = Date + 2: End With
If Not Intersect([S:S], Target) Is Nothing Then
         With Target.Offset(0, -1)
            .NumberFormat = "m/d/yyyy": .Value2 = Date + 2: End With
      Application.EnableEvents = True
   ElseIf Target.Column = 2 Then
      Dim Cel As Range
      Set Cel = Sheets("Mes listes").Columns(1).Cells.Find(what:=Target.Value, LookAt:=xlWhole)
      If Not Cel Is Nothing Then
         Application.EnableEvents = False
         Target.Offset(0, 1).Value = Cel.Offset(0, 1).Value
         Application.EnableEvents = True
         End If
   End Sub

 

[Dranreb]

Voulez-vous dire que ça doit réagir si on modifie plusieurs cellules en même temps ?
Je n'ai pas l'impression.
Le code que je proposai au #20 prévoyait bien un traitement supplémentaire des cellules à gauche des colonnes J et S, en plus de celui de celles à leur droite.
Je ne comprends pas ce que vous voulez dire.
Dans votre code il me semble y avoir un risque que Application.EnableEvents soit laissé à False à la fin de l'exécution. Après plus rien ne marche !
Et puis écrit comme ça il doit manquer plein de End If, non ?

 

[Phylo]

Voici l'exemple

j'ai mis les initiales dans la cellule de la colonne L il doit me donner la date seulement dans M alors qu'il a mis la date aussi dans la cellule de la colonne O

 

[Dranreb]

Je n'avais pas constaté ça. Je n'ai pas gardé le fichier. Mettez un point d'arrêt et déroulez en pas à pas si c'est reproductible …

 

[Phylo]

Désolé j'allais dire je veux pas de dépendance entre chaque transaction

comme le code avant

j'ai séparé chaque transaction

date réception
Date révision et
date de relache

la date est donné

 

[Dranreb]

Comprends rien. il ne réagit que pour la colonne modifiée c'est tout.

 

[Phylo]

Merci Dranreb

Je ne sais pas pourquoi maintenant c'est bon

peut etre j'ai fait une copier coller d'une cellule

en tous cas merci bcp pour le temps que tu as consacré


bien a toi

 

[Phylo]

Salut

J'ai constaté comme si j'ai une fonction now malgré que j'ai mis date a la place ???
moi je veux qu'il me fige la date enregistré mais avec une format dd-mm-aaaa
tout est fonctionnel

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Me.ListObjects(1).DataBodyRange, Target) Is Nothing Then Exit Sub
   If Not Intersect([J:J,L:L,N:N,S:S,U:U,W:W], Target) Is Nothing Then
      Application.EnableEvents = False
      With Target.Offset(0, 1)
         .NumberFormat = "m/d/yyyy": .Value2 = Date: End With
      If Not Intersect([J:J,S:S], Target) Is Nothing Then
         With Target.Offset(0, -1)
            .NumberFormat = "m/d/yyyy": .Value2 = Date + 2: End With
         End If
      Application.EnableEvents = True
   ElseIf Target.Column = 2 Then
      Dim Cel As Range
      Set Cel = Sheets("Mes listes").Columns(1).Cells.Find(what:=Target.Value, LookAt:=xlWhole)
      If Not Cel Is Nothing Then
         Application.EnableEvents = False
         Target.Offset(0, 1).Value = Cel.Offset(0, 1).Value
         Application.EnableEvents = True
         End If
      End If
   End Sub

 

[Phylo]

voila l'exemple

quand j'enregistre les modifications apportés il me fait le 14-09-2020 pour toutes les dates