XL 2019 Problème avec une macro :(

chinel · 24 Janvier 2023

Bonjour tout le monde, j'ai incorporé le code de @patricktoulon qui a bien voulu m'aider dans le poste précédant et je le remercie pour son travaile.
voici son code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
Application.EnableEvents = False
If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
If WorksheetFunction.CountBlank([A2:A10]) = 0 Then [A2:A10].ClearContents
Cells(11, 1).End(xlUp).Offset(1) = [d1]
End If
Application.EnableEvents = True
End Sub

J'ai modifier celui-ci pour qu'il s'adapte à mon programme, voici la modification. Mais quand je lance mon programme, les données ne se mettent pas au bon endroit, mais en cellule A11 pourquoi ? je n'en sais rien ?!?!

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
Application.EnableEvents = False
If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
If WorksheetFunction.CountBlank([E38:E46]) = 0 Then [E38:E46].ClearContents
Cells(11, 1).End(xlUp).Offset(1) = [h36]
End If
Application.EnableEvents = True
End Sub

Merci de votre aide !

vgendron · 24 Janvier 2023

Ton fichier ne permet pas de comprendre ce que tu veux mettre ou...
mais.. ma boule de cristal me dit essaie ca

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
    Application.EnableEvents = False
    If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
    If WorksheetFunction.CountBlank([E38:E49]) = 0 Then [E38:E49].ClearContents
    ligne = WorksheetFunction.Max(38, Cells(47, 5).End(xlUp).Offset(1).Row)
    Cells(ligne, 5) = [h36]
End If
Application.EnableEvents = True
End Sub

patricktoulon · 24 Janvier 2023

Bonjour
ton fichier n'est pas représentatif de ta demande initiale
tu clear les cells E38:E46
je suppoose donc que ce sont les cellules de reception
et donc la destination est
Cells(47, 5).End(xlUp).Offset(1) = [h36]
c'est pas compliqué a comprendre

TooFatBoy · 24 Janvier 2023

Bonjour,

Ça n'a pas de rapport avec le problème rencontré, mais il me semble que cette instruction :

chinel à dit:
Application.EnableEvents = False

n'est pas au bon endroit.

chinel · 24 Janvier 2023

patricktoulon à dit:
Bonjour
ton fichier n'est pas représentatif de ta demande initiale
tu clear les cells E38:E46
je suppoose donc que ce sont les cellules de reception
et donc la destination est
Cells(47, 5).End(xlUp).Offset(1) = [h36]
c'est pas compliqué a comprendre

c'est vrai que j'aurai dû mettre le fichier plus tôt

chinel · 24 Janvier 2023

patricktoulon à dit:
Bonjour
ton fichier n'est pas représentatif de ta demande initiale
tu clear les cells E38:E46
je suppoose donc que ce sont les cellules de reception
et donc la destination est
Cells(47, 5).End(xlUp).Offset(1) = [h36]
c'est pas compliqué a comprendre

les cellules de réceptions sont E38:E46 et la cellule de donnée est H36

chinel · 24 Janvier 2023

@patricktoulon quand je modifie avec "Cells(47, 5).End(xlUp).Offset(1) = [h36]" les données vont en E3 pourquoi ???

vgendron · 24 Janvier 2023

bonjour..
apparemment tu n'as pas compris cette insruction:
Cells(47, 5).End(xlUp).Offset(1) = [h36]

SI E47 contient quelque chose
à partir de la cellule E47, on remonte vers le haut jusqu'à la première ligne vide pour y mettre le contenu de H36

SI E47 est vide
à partir de la cellule E47, on remonte vers le haut jusqu'à la première ligne NON vide pour y mettre le contenu de H36

pour voir ce que ca fait sur ton fichier:
selectionne E47, et avec la souris, double clic sur la bordure supérieure de la cellule

chinel · 24 Janvier 2023

vgendron à dit:
bonjour..
apparemment tu n'as pas compris cette insruction:
Cells(47, 5).End(xlUp).Offset(1) = [h36]

SI E47 contient quelque chose
à partir de la cellule E47, on remonte vers le haut jusqu'à la première ligne vide pour y mettre le contenu de H36

SI E47 est vide
à partir de la cellule E47, on remonte vers le haut jusqu'à la première ligne NON vide pour y mettre le contenu de H36

pour voir ce que ca fait sur ton fichier:
selectionne E47, et avec la souris, double clic sur la bordure supérieure de la cellule

Merci pour l'explication mais cela ne résout pas mon problème ou alors, il faut modifier le code car la colonne 5 (colonne E) il y aura toujours des cellules vides

vgendron · 24 Janvier 2023

Ton fichier ne permet pas de comprendre ce que tu veux mettre ou...
mais.. ma boule de cristal me dit essaie ca

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
    Application.EnableEvents = False
    If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
    If WorksheetFunction.CountBlank([E38:E49]) = 0 Then [E38:E49].ClearContents
    ligne = WorksheetFunction.Max(38, Cells(47, 5).End(xlUp).Offset(1).Row)
    Cells(ligne, 5) = [h36]
End If
Application.EnableEvents = True
End Sub

chinel · 24 Janvier 2023

vgendron à dit:

Ton fichier ne permet pas de comprendre ce que tu veux mettre ou...
mais.. ma boule de cristal me dit essaie ca

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
    Application.EnableEvents = False
    If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
    If WorksheetFunction.CountBlank([E38:E49]) = 0 Then [E38:E49].ClearContents
    ligne = WorksheetFunction.Max(38, Cells(47, 5).End(xlUp).Offset(1).Row)
    Cells(ligne, 5) = [h36]
End If
Application.EnableEvents = True
End Sub

Un grand merci à toi et garde bien ta boule de cristal . Bonne journée à vous !!!

Phil69970 · 24 Janvier 2023

Bonjour à tous

Perso une chose me chiffonne dans le code c'est :

If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub

Car si on rentre dans la condition alors je vois un problème ici :

Application.EnableEvents = True
End Sub

Donc je ferais plutôt comme ceci

If Target = "" Or Not IsDate(Target.Value) Then
Target = ""
Application.EnableEvents = True
Exit Sub
End If

Mais je dis ça je dis rien !!!

@Phil69970

patricktoulon · 24 Janvier 2023

re
et oui il fallait s'en douter etant donné que l'on est plus en A2 il faut forcement limiter au min 38

Bonjour @Phil69970
comme je l'ai dis dans une autre discussion ,ca n'est pas une erreur
pour moi dans tout les cas de figure a la fin de la macro les events doivent êtres rétablis
c'est une de mes règles d'or
il est donc pour moi evident que mettre les events à true doit sortir de toute conditions que quelque genre que ce soit et juste avant le "end sub"

vgendron · 24 Janvier 2023

GRRRRRRRR !!!

ce serait sympa aussi de prévenir que ton code modifie l'apparence d'excel en masquant le ruban et autre!!

patricktoulon · 24 Janvier 2023

Bonjour @vgendron
en aucun cas le code que j'ai donné a @chinel ne modifie le ruban
c'est dans son fichier qu'il a du mettre ça

Phil69970 · 24 Janvier 2023

@patricktoulon

Patrick :

Ce que j'ai voulu dire c'est

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
    Application.EnableEvents = False
   
    '*******
    'Si on entre dans la condition alors il me semble que
    'Application.EnableEvents = True n'est pas fait
    If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
    '*******
   
    If WorksheetFunction.CountBlank([E38:E49]) = 0 Then [E38:E49].ClearContents
    ligne = WorksheetFunction.Max(38, Cells(47, 5).End(xlUp).Offset(1).Row)
    Cells(ligne, 5) = [h36]
End If
Application.EnableEvents = True
End Sub

Et perso je ferais ça

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
    Application.EnableEvents = False
    If Target = "" Or Not IsDate(Target.Value) Then
        Target = ""
        Application.EnableEvents = True     'Remets events
        Exit Sub
    End If
    If WorksheetFunction.CountBlank([E38:E49]) = 0 Then [E38:E49].ClearContents
    ligne = WorksheetFunction.Max(38, Cells(47, 5).End(xlUp).Offset(1).Row)
    Cells(ligne, 5) = [h36]
End If
Application.EnableEvents = True
End Sub

Maintenant je peux me tromper mais je c'est ce que je comprends du code post #9

@Phil69970

XL 2019 Problème avec une macro :(

chinel

XLDnaute Impliqué

Pièces jointes

vgendron

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Discussions similaires