Problème avec un code de date figée

[Choops]

Bonjour à tous,
je viens d’essayer un code qui permet d’inscrire automatiquement dans une cellule la date de modification de cellules d’une colonne.
https://www.excel-downloads.com/threads/date-figee-une-suite-un-peu-sioux.76119/

Le code fonctionne mais j’obtiens une erreur lorsque j’efface une sélection d’un coup (comme par exemple A10:A15) et le débogueur se lance. Il se lance aussi quand je supprime une ligne entière.

- Quel serait le code à ajouter pour étendre l’action de la macro sur des sélections ? et pour éviter le bug quand on efface une ligne entière ?

- Serait-il possible d’avoir un code qui n’indique la date de modif seulement si la nouvelle valeur entrée est différente de l’ancienne ?
Merci d’avance !

 

[wilfried_42]

Re : Problème avec un code de date figée

bonjour

Ajoute la ligne en rouge (Sors de la macro s'il y a plus d'une cellule de selectionnée)

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Red"]    If Target.Cells.Count > 1 Then Exit Sub[/COLOR]
    If Not Intersect(Target, Range("a3:a22")) Is Nothing Then
        If Target.Value > "" Then Range("B" & Target.Row) = Date
    End If
End Sub

 

[Choops]

Re : Problème avec un code de date figée

Bonjour,

Merci pour ta réponse mais cela m’empêche de faire ce que j’ai décrit dans les 2 points de mon 1er post !

 

[abc]

Re : Problème avec un code de date figée

Bonsoir,
essaye et dis quoi
If Target.Column = 1 Then
Target.Offset(0, 4) = Now
End If
si quelque chose en colonne 1, date 4 colonne plus loin
A +

 

[Choops]

Re : Problème avec un code de date figée

Hello,

effectivement le code fonctionne désormais pour les sélections mais le problème du bug quand on supprime une ligne est toujours là. J’espère que ça sera possible à résoudre!

 

[ninbihan]

Re : Problème avec un code de date figée

Bonsoir à tous,


Peut être ainsi:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("a3:a22")) Is Nothing And Target.Columns.Count = 1 Then

Target.Offset(0, 1) = Date
End If

End Sub

Bonne soirée,

Ninbihan

 

[Choops]

Re : Problème avec un code de date figée

Hello ! Effectivement cela résout le problème lors de la suppression des lignes! Tu aurais une idée pour l’histoire des entrées différentes ?

 

[ninbihan]

Re : Problème avec un code de date figée

Bonjour,

A tester:

Public flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vali As Variant
If flag = True Then Exit Sub
flag = True
Application.ScreenUpdating = False
If Not Intersect(Target, Range("a3:a22")) Is Nothing And Target.Columns.Count = 1 Then
vali = Target.Value

Application.Undo

    If vali <> Target.Value Then
    Target.Offset(0, 1) = Date
    Target.Value = vali
    End If
End If
Application.ScreenUpdating = True
flag = False
End Sub

Meric à PJ pour le flag

Bonne soirée,

Ninbihan

 

[Choops]

Re : Problème avec un code de date figée

Bonjour,
merci pour le code! Cela fonctionne bien mais par contre le bug qui intervient quand on efface plusieurs cellules d'un coup est revenu. Le débogueur indique un problème à partir de cette ligne là:
If vali <> Target.Value Then

Merci !

 

[ninbihan]

Re : Problème avec un code de date figée

Re,


A retester:

Public flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vali As Variant
If flag = True Then Exit Sub
flag = True
Application.ScreenUpdating = False
If Not Intersect(Target, Range("a3:a22")) Is Nothing And Target.cells.count=1 Then
vali = Target.Value

Application.Undo

    If vali <> Target.Value Then
    Target.Offset(0, 1) = Date
    Target.Value = vali
    End If
End If
Application.ScreenUpdating = True
flag = False
End Sub

Bonne soirée,

Ninbihan

 

[Choops]

Re : Problème avec un code de date figée

Merci beaucoup ninbihan!