petite modif sur ce code vba ?

kinel

XLDnaute Occasionnel
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
 
C

Compte Supprimé 979

Guest
Re : petite modif sur ce code vba ?

Bonjour Kinel

Voici ton code modifié avec quelques commentaires
VB:
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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....
Code:
  If Target.Value = "" Then Exit Sub
Donc...
Code:
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
Code:
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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 ?
Code:
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
 
Dernière édition:

kinel

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • kinel.xls
    20.5 KB · Affichages: 37
  • kinel.xls
    20.5 KB · Affichages: 44
  • kinel.xls
    20.5 KB · Affichages: 48

kinel

XLDnaute Occasionnel
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
 

Discussions similaires

Statistiques des forums

Discussions
312 799
Messages
2 092 220
Membres
105 295
dernier inscrit
nroch