XL 2019 Problème avec une macro :(

chinel

XLDnaute Impliqué
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 !
 

Pièces jointes

  • Smed 2022_vers.04.xlsm
    257.5 KB · Affichages: 9
Solution
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

vgendron

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

XLDnaute Impliqué
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

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

XLDnaute Impliqué
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

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

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

Phil69970

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

Discussions similaires

Réponses
1
Affichages
282

Statistiques des forums

Discussions
315 093
Messages
2 116 140
Membres
112 669
dernier inscrit
Guigui2502