Changement Date automatique

Le
nounouille
Bonjour,

J'ai commencé un code pour une feuille de classeur, mais c'est
incomplet et çà plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donnée dans la 1ère cellule de la 1ère ligne vide
Met la date même ligne col B et col P
Si je modifie une donnée d'une cellule x de la col 5
Met la date même ligne col O
Si je sélectionne une ou + lignes entières pour les supprimer
Accepte mes désirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Ligne As Integer
Application.MoveAfterReturnDirection =
xlToRight 'Pour que la sélection se dépalce sur la droite

If Target.Column <> 1 Then Exit Sub 'Pour ma 1ère
condition
Ligne = [A9999].End(xlUp).Row + 0
Cells(Ligne, 2).Value = Date
Cells(Ligne, 16).Value = Date

If Intersect(Target, Columns(8)) Is Nothing Then 'Pour
ma 2ème condition
Target.Offset(, 7) = Date 'Mais çà plante là

'Quant à mes désirs, je n'ai rien trouvé

End Sub

Pouvez-vous m'aider une fois de plus ? UN grand merci par avance.
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #5280061
Bonjour,

http://cjoint.com/?ciq0ahjeuz

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
If Target.Offset(0, 1) = "" Then
Application.EnableEvents = False
Target.Offset(0, 1) = Date
Target.Offset(0, 15) = Date
Application.EnableEvents = True
End If
End If
If Target.Column = 5 And Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(0, 10) = Date
Application.EnableEvents = True
End If
End Sub

JB



On 8 fév, 14:37, nounouille wrote:
Bonjour,

J'ai commencé un code pour une feuille de classeur, mais c'est
incomplet et çà plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donnée dans la 1ère cellule de la 1ère ligne vide
        Met la date même ligne col B et col P
Si je modifie une donnée d'une cellule x de la col 5
        Met la date même ligne col O
Si je sélectionne une ou + lignes entières pour les supprimer
        Accepte mes désirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Ligne As Integer
            Application.MoveAfterReturnDirection =
xlToRight            'Pour que la sélection se dépalce sur la droite

    If Target.Column <> 1 Then Exit Sub            'Pour m a 1ère
condition
    Ligne = [A9999].End(xlUp).Row + 0
    Cells(Ligne, 2).Value = Date
    Cells(Ligne, 16).Value = Date

    If Intersect(Target, Columns(8)) Is Nothing Then            'Pour
ma 2ème condition
    Target.Offset(, 7) = Date            'Mais çà pl ante là

            'Quant à mes désirs, je n'ai rien trouvé

End Sub

Pouvez-vous m'aider une fois de plus ? UN grand merci par avance.


Daniel.C
Le #5280041
Bonjour.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'Application.MoveAfterReturnDirection = xlToRight
Application.EnableEvents = False
If Target.Column = 1 Then
Cells(Target.Row, 2) = Date
Cells(Target.Row, 16) = Date
ElseIf Target.Column = 5 Then
Cells(Target.Row, 15) = Date
End If
Application.EnableEvents = False
End Sub

La macro ne fait pas la différence entre ajout et modif. Si tu y tiens,
c'est un peu plus compliqué.
Cordialement.
Daniel
"nounouille" message de news:

Bonjour,

J'ai commencé un code pour une feuille de classeur, mais c'est
incomplet et çà plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donnée dans la 1ère cellule de la 1ère ligne vide
Met la date même ligne col B et col P
Si je modifie une donnée d'une cellule x de la col 5
Met la date même ligne col O
Si je sélectionne une ou + lignes entières pour les supprimer
Accepte mes désirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Ligne As Integer
Application.MoveAfterReturnDirection xlToRight 'Pour que la sélection se dépalce sur la droite

If Target.Column <> 1 Then Exit Sub 'Pour ma 1ère
condition
Ligne = [A9999].End(xlUp).Row + 0
Cells(Ligne, 2).Value = Date
Cells(Ligne, 16).Value = Date

If Intersect(Target, Columns(8)) Is Nothing Then 'Pour
ma 2ème condition
Target.Offset(, 7) = Date 'Mais çà plante là

'Quant à mes désirs, je n'ai rien trouvé

End Sub

Pouvez-vous m'aider une fois de plus ? UN grand merci par avance.
Daniel.C
Le #5279911
Oups:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.MoveAfterReturnDirection = xlToRight
Application.EnableEvents = False
If Target.Column = 1 Then
Cells(Target.Row, 2) = Date
Cells(Target.Row, 16) = Date
ElseIf Target.Column = 5 Then
Cells(Target.Row, 15) = Date
End If
Application.EnableEvents = True
End Sub

"Daniel.C" OZ$
Bonjour.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'Application.MoveAfterReturnDirection = xlToRight
Application.EnableEvents = False
If Target.Column = 1 Then
Cells(Target.Row, 2) = Date
Cells(Target.Row, 16) = Date
ElseIf Target.Column = 5 Then
Cells(Target.Row, 15) = Date
End If
Application.EnableEvents = False
End Sub

La macro ne fait pas la différence entre ajout et modif. Si tu y tiens,
c'est un peu plus compliqué.
Cordialement.
Daniel
"nounouille" message de news:

Bonjour,

J'ai commencé un code pour une feuille de classeur, mais c'est
incomplet et çà plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donnée dans la 1ère cellule de la 1ère ligne vide
Met la date même ligne col B et col P
Si je modifie une donnée d'une cellule x de la col 5
Met la date même ligne col O
Si je sélectionne une ou + lignes entières pour les supprimer
Accepte mes désirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Ligne As Integer
Application.MoveAfterReturnDirection > xlToRight 'Pour que la sélection se dépalce sur la droite

If Target.Column <> 1 Then Exit Sub 'Pour ma 1ère
condition
Ligne = [A9999].End(xlUp).Row + 0
Cells(Ligne, 2).Value = Date
Cells(Ligne, 16).Value = Date

If Intersect(Target, Columns(8)) Is Nothing Then 'Pour
ma 2ème condition
Target.Offset(, 7) = Date 'Mais çà plante là

'Quant à mes désirs, je n'ai rien trouvé

End Sub

Pouvez-vous m'aider une fois de plus ? UN grand merci par avance.



nounouille
Le #5277731
On 8 fév, 17:44, "Daniel.C"
Oups:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.MoveAfterReturnDirection = xlToRight
Application.EnableEvents = False
If Target.Column = 1 Then
    Cells(Target.Row, 2) Úte
    Cells(Target.Row, 16) Úte
ElseIf Target.Column = 5 Then
    Cells(Target.Row, 15) Úte
End If
Application.EnableEvents = True
End Sub

"Daniel.C" OZ$



Bonjour.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'Application.MoveAfterReturnDirection = xlToRight
Application.EnableEvents = False
If Target.Column = 1 Then
   Cells(Target.Row, 2) Úte
   Cells(Target.Row, 16) Úte
ElseIf Target.Column = 5 Then
   Cells(Target.Row, 15) Úte
End If
Application.EnableEvents = False
End Sub

La macro ne fait pas la différence entre ajout et modif. Si tu y tiens ,
c'est un peu plus compliqué.
Cordialement.
Daniel
"nounouille" message de news:

Bonjour,

J'ai commencé un code pour une feuille de classeur, mais c'est
incomplet et çà plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donnée dans la 1ère cellule de la 1ère ligne vide
Met ladatemême ligne col B et col P
Si je modifie une donnée d'une cellule x de la col 5
Met ladatemême ligne col O
Si je sélectionne une ou + lignes entières pour les supprimer
Accepte mes désirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

   Dim Ligne As Integer
           Application.MoveAfterReturnDirection =
xlToRight            'Pour que la sélection se dépalce s ur la droite

   If Target.Column <> 1 Then Exit Sub            'Pour ma 1ère
condition
   Ligne = [A9999].End(xlUp).Row + 0
   Cells(Ligne, 2).Value Úte
   Cells(Ligne, 16).Value Úte

   If Intersect(Target, Columns(8)) Is Nothing Then            'Pour
ma 2ème condition
   Target.Offset(, 7) Úte           'Mais çà pla nte là

           'Quant à mes désirs, je n'ai rien trouvé

End Sub

Pouvez-vous m'aider une fois de plus ? UN grand merci par avance.- Masqu er le texte des messages précédents -


- Afficher le texte des messages précédents -


Ce qui est génial avec vous c'est que çà fonctionne et en plus çà ma
permis de penser autrement mon tableau et d'adapter les formules.
Grand grand merci !


Publicité
Poster une réponse
Anonyme