[XL-2007] Ajout de date automatique à la saisie [Résolu]

[rainette]

Bonjour,
Voici un code pour excel qui saisi la date du jour automatiquement dans une cellule (2eme colonne) lorsque l'on saisi des données dans certaines cellules de la ligne correspondante.

Code :

1
2
3
4
5
6
7
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 3 And Target.Count = 1 Then
Target.Offset(0, -1) = Date
ElseIf Target.Column = 4 And Target.Count = 1 Then
Target.Offset(0, -2) = Date
End If
End Sub

Le problème est qu'avec ce code, si je modifie une cellule où la date a déjà été saisie, cette dernière se met automatiquement à jour. Je souhaiterais donc que la date s'inscrive uniquement si elle n'a pas déjà été renseignée.

Voici donc le code que j'ai réalisé:

Code :

1
2
3
4
5
6
7
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 3 And Target.Count = 1 And Target.Offset(0, -1) = Vide Then
Target.Offset(0, -1) = Date
ElseIf Target.Column = 4 And Target.Count = 1 And Target.Offset(0, -2) = Vide Then
Target.Offset(0, -2) = Date
End If
End Sub

Mais j'ai un message d'erreur à chaque fois que j'ajoute une valeur.
Le débogueur me souligne cette ligne

Code :

1
2
ElseIf Target.Column = 4 And Target.Count = 1 And Target.Offset(0, 2) = Vide Then
Target.Offset(0, -2) = Date

Avez-vous une idée pour éviter ce message d'erreur?
Merci d'avance pour votre aide.

[Runsh63]

Bonjour,

Essaye avec ceci :

Code :

1
2
ElseIf Target.Column = 4 And Target.Count = 1 And Target.Offset(0, 2) = "" Then
Target.Offset(0, -2) = Date

Tiens-moi au courant.

[jfontaine]

Bonjour,

Mais j'ai un message d'erreur à chaque fois que j'ajoute une valeur.
Le débogueur me souligne cette ligne

Quelle Erreur?


Une simplification de ton code

Code :

1
2
3
4
5
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If (Target.Column = 3 or Target.Column = 4) And Target.Count = 1 And sh.Range("B" & target.Row).Value = "" Then
     sh.Range("B" & target.Row).Value = Date
End If
End Sub

[rainette]

Merci pour votre réponse rapide.
Runsh63 ta solution n'a pas fonctionné.

jfontaine le message d'erreur qui s'affichait était "Erreur d'exécution '1004', Erreur définie par l'application ou par l'objet".
Mais avec ton nouveau code, cela marche parfaitement.

Encore merci à tous les deux pour votre aide!