XL 2019 Problème avec une macro :(

[chinel]

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 !

 

[chinel]

Pour moi, vous parler un peu chinois dois je modifier quelque chose dans le code @vgendron ?

 

[Phil69970]

@chinel

Perso je ferais comme mon post #15

@Phil69970

 

[patricktoulon]

Patrick

Ce que j'ai voulu dire c'est

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

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

re
oui tu a effectivement raison ,en fait il faut simplement déplacer la ligne
autrement le switch des events est modifié uniquement si on est pas exit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
     If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
 Application.EnableEvents = False
  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

 

[Phil69970]

Patrick

Effectivement c'est aussi une autre solution

@Phil69970

 

[vgendron]

non non @patricktoulon , mon GRRR ne s'adressait pas à toi, mais bien à l'auteur du post initial

 

[chinel]

re
oui tu a effectivement raison ,en fait il faut simplement déplacer la ligne
autrement le switch des events est modifié uniquement si on est pas exit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
     If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
 Application.EnableEvents = False
  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

Avoir descendu la ligne cela change grand chose ?

Application.EnableEvents = False

 

[chinel]

non non @patricktoulon , mon GRRR ne s'adressait pas à toi, mais bien à l'auteur du post initial

ce n'est pas la fin du monde quand même ? j'ai pensé à enlever le mot de passe du projet vba et pour le reste, il fallait juste aller sur rétrécir la fenêtre, désolé quand même d'avoir oublié de le signaler !

 

[Phil69970]

@chinel

Si tu as lus mes post et compris ce que j'ai écrit tu ne poserais pas la question.

Pour résumé que ce soit ma version post #15 ou celle de Patrick au post #18 c'est bon

@Phil69970

 

[chinel]

@chinel

Si tu as lus mes post et compris ce que j'ai écrit tu ne poserais pas la question.

Pour résumé que ce soit ma version post #15 ou celle de Patrick au post #18 c'est bon

@Phil69970

oups j'ai loupé des post déso

 

[vgendron]

ce n'est pas la fin du monde quand même ? j'ai pensé à enlever le mot de passe du projet vba et pour le reste, il fallait juste aller sur rétrécir la fenêtre, désolé quand même d'avoir oublié de le signaler !

bah non c'est sur !!
la prochaine fois je te mettrai un fichier qui modifie tes paramètres systemes pour passer tout en Arabe..
simple.. il te suffira d'apprendre l'arabe pour retrouver le menu langue!

 

[TooFatBoy]

Perso une chose me chiffonne dans le code

C'est qu'est-ce que j'ai dit en #3 : problème de logique qui fait que les événements ne sont pas réactivés dans tous les cas.

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

Alors, sauf erreur de ma part, il faut revoir ton code.


[edit]

Ah, je vois qu'en #18 tu as déplacé l'instruction comme je le disais en #3.

Mais est-ce qu'on ne risque pas de tourner en rond du coup :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$36" Then
        If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
        Application.EnableEvents = False
        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]
        Application.EnableEvents = True
    End If
End Sub

Pour être sûr, il vaudrait peut-être mieux utiliser un truc dans ce genre :

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 = ""
        Else
            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 If
End Sub

[/edit]

 

[patricktoulon]

re

Mais est-ce qu'on ne risque pas de tourner en rond du coup :

ben non puisque si exit je vide la cellule en "D1"
donc l'event redéclenché passe pas le 1err if (if target.address="$D$1" and target<>""then

 

[TooFatBoy]

ben non puisque si exit je vide la cellule en "D1"
donc l'event redéclenché passe pas le 1err if (if target.address="$D$1" and target<>""then

OK, mais le premier IF ne ressemble pas à ça dans la macro que tu donnes en #18 et dont je parle :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$36" Then
     If Target = "" Or Not IsDate(Target.Value) Then Target = "": Exit Sub
 Application.EnableEvents = False
  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

d'où mon interrogation sur une éventuelle boucle infinie.