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

chinel · 24 Janvier 2023

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

Phil69970 · 24 Janvier 2023

@chinel

Perso je ferais comme mon post #15

@Phil69970

patricktoulon · 24 Janvier 2023

Phil69970 à dit:

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

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

VB:

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 · 24 Janvier 2023

Patrick

Effectivement c'est aussi une autre solution

@Phil69970

vgendron · 24 Janvier 2023

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

chinel · 24 Janvier 2023

patricktoulon à dit:
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

VB:

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 · 24 Janvier 2023

vgendron à dit:
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 · 24 Janvier 2023

@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 · 24 Janvier 2023

Phil69970 à dit:
@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 · 24 Janvier 2023

chinel à dit:
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 · 24 Janvier 2023

Phil69970 à dit:
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.

patricktoulon à dit:
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 :

patricktoulon à dit:

Enrichi (BBcode):

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 :

Enrichi (BBcode):

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 · 24 Janvier 2023

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 · 24 Janvier 2023

patricktoulon à dit:
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 :

Enrichi (BBcode):

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.

XL 2019 Problème avec une macro :(

chinel

XLDnaute Impliqué

Pièces jointes

vgendron

chinel

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

Phil69970

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

vgendron

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Discussions similaires