Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Changement Date automatique

4 réponses
Avatar
nounouille
Bonjour,

J'ai commenc=E9 un code pour une feuille de classeur, mais c'est
incomplet et =E7=E0 plante. Voici ce que je souhaite obtenir :

Si j'ajoute une donn=E9e dans la 1=E8re cellule de la 1=E8re ligne vide
Met la date m=EAme ligne col B et col P
Si je modifie une donn=E9e d'une cellule x de la col 5
Met la date m=EAme ligne col O
Si je s=E9lectionne une ou + lignes enti=E8res pour les supprimer
Accepte mes d=E9sirs

Voici ce que j'ai fait :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Ligne As Integer
Application.MoveAfterReturnDirection =3D
xlToRight 'Pour que la s=E9lection se d=E9palce sur la droite

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

If Intersect(Target, Columns(8)) Is Nothing Then 'Pour
ma 2=E8me condition
Target.Offset(, 7) =3D Date 'Mais =E7=E0 plante l=E0

'Quant =E0 mes d=E9sirs, je n'ai rien trouv=E9

End Sub

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

4 réponses

Avatar
JB
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.


Avatar
Daniel.C
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" a écrit dans le
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.
Avatar
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) = 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" a écrit dans le message de news:
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" a écrit dans le
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.



Avatar
nounouille
On 8 fév, 17:44, "Daniel.C" wrote:
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" a écrit dans le message de news:
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" a écrit dans l e
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 !