petite modif sur ce code vba ?

[kinel]

bonjour à tous

j'utilise le code suivant pour afficher la date sur la ligne dont les cellules ont été modifiées
ça fonctionne très bien quand je change le contenu sauf quand j'efface simplement une cellule

auriez vous une idée de code pour que ma date s'affiche dans les deux cas ?

merci de votre aide
Kinel

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Set WatchRange = Range("C4:M33")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'on ne fait rien si pas de changement
Else
'ici commence si changement detecté
Numero_ligne = ActiveCell.Row
Worksheets("Feuil4").Range("O" & Numero_ligne).Value = Date
End If
End Sub

 

[Compte Supprimé 979]

Re : petite modif sur ce code vba ?

Bonjour Kinel

Voici ton code modifié avec quelques commentaires

Private Sub Worksheet_Change(ByVal Target As Range)  Dim WatchRange As Range
  Dim IntersectRange As Range
  ' Si sélection de plusieurs ligne on sort, sinon bug avec Target.Value
  If Target.Count > 1 Then Exit Sub
  ' Tester s'il s'agit d'un effacement
  If Target.Value = "" Then Exit Sub
  '
  Set WatchRange = Range("C4:M33")
  Set IntersectRange = Intersect(Target, WatchRange)
  If IntersectRange Is Nothing Then
    'on ne fait rien si pas de changement
  Else
    'ici commence si changement detecté
    ' Empêcher les évènements car on modifie la cellule
    ' => risque de boucle infinie
    Application.EnableEvents = False
    '
    Numero_ligne = ActiveCell.Row
    Worksheets("Feuil4").Range("O" & Numero_ligne).Value = Date
    ' Activer de nouveau les évènements
    Application.EnableEvents = True
  End If
End Sub

A+

 

[kinel]

Re : petite modif sur ce code vba ?

bonsoir Bruno

merci pour cette modif
je l'ai essayée mais sans succès, ça ne tient pas compte de l'effacement de cellule

n'est ce pas sur le "IntersectRange" qu'il y aurait un soucis ?
n'existe t il pas une commande spécifique qui surveillerait aussi l'effacement ?

 

[kjin]

Re : petite modif sur ce code vba ?

Bonsoir,

je l'ai essayée mais sans succès, ça ne tient pas compte de l'effacement de cellule

Normal....

  If Target.Value = "" Then Exit Sub

Donc...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C4:M33")) Is Nothing Then
    Worksheets("Feuil4").Range("O" & Target.Row).Value = Date
End If
End Sub

...en supposant que la feuille4 n'est pas la feuille active (celle qui contient la macro) sinon

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C4:M33")) Is Nothing Then
    Application.EnableEvents = False
    Range("O" & Target.Row).Value = Date
    Application.EnableEvents = True
End If
End Sub

A+
kjin

 

[kinel]

Re : petite modif sur ce code vba ?

bonjour

merci à vous deux, j'essaye tout ça

amitiés à "Hassan"

 

[kinel]

Re : petite modif sur ce code vba ?

bonjour à tous

désolé ça fonctionne toujours pas au niveau de la détection de l'effacement

voici le code testé :

Dim WatchRange As Range
Dim IntersectRange As Range

If Target.Count > 1 Then Exit Sub
If (Not Intersect(Target, Range("C4:M33")) Is Nothing) Or (Target.Value = "") Then
Application.EnableEvents = False
Range("O" & Target.Row).Value = Date
Application.EnableEvents = True
End If


merci de votre aide

Kinel

 

[kjin]

Re : petite modif sur ce code vba ?

Bonjour,
Pourquoi modifies tu les propositions.....que manifestement tu ne comprends pas !?

Dim WatchRange As Range
Dim IntersectRange As Range

If Target.Count > 1 Then Exit Sub
If (Not Intersect(Target, Range("C4:M33")) Is Nothing) Or (Target.Value = "") Then
Application.EnableEvents = False
Range("O" & Target.Row).Value = Date
Application.EnableEvents = True
End If

...ou as tu vu que j'avais écris ça ?

If Not Intersect(Target, Range("C4:M33")) Is Nothing

ceci vérifie que la cellule modifiée (Target) se trouve bien dans la plage C4:M33 ce qui génère l'évènement Change et ceci aussi bien lors de la saisie que lors de l'effacement, un changement quoi !
Si la cellule O correspondante
- ne contenait rien, elle reçoit la date du jour
- contenait déjà une date, elle est actualisée à la date du jour
- contenait déjà la date du jour, il ne passe rien
Quand aux 2 variables, elles ne servent à rien car non utilisées !

Ouf

 

[kinel]

Re : petite modif sur ce code vba ?

effectivement je ne maîtrise pas tout
merci de pardonner mon ignorance !

j'ai essayé avec ça et ça ne me détecte toujours pas l'effacement d'une cellule

Dim WatchRange As Range
Dim IntersectRange As Range

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C4:M33")) Is Nothing Then
Application.EnableEvents = False
Range("O" & Target.Row).Value = Date
Application.EnableEvents = True
End If

 

[mutzik]

Re : petite modif sur ce code vba ?

bonjour à toutes et tous

testé : If IsEmpty(Target) Then Target = Date 'pour vérifier qu'on a appuyé sur la touche suppr
oublier : Application.EnableEvents ... (les deux lignes)

NB dans ton cas, tu peux remplacer Target = Date par Range("O" & Target.Row).Value = Date

 

[kjin]

Re : petite modif sur ce code vba ?

Re,

effectivement je ne maîtrise pas tout
merci de pardonner mon ignorance !

Là n'est pas la question, et je n'ai pas la prétention de tout connaitre non plus...
Mais je ne comprends toujours pas ton pb
Voir PJ

 

[kinel]

Re : petite modif sur ce code vba ?

cette fois ça y est !!!

dans le Private Sub Worksheet_Change(ByVal Target As Range)

j'ai d'autres commandes qui me permettent d'automatiser la majuscule dans une partie des cellules

en plaçant le code de kjin au début ça fonctionne très bien

Merci encore