Macro événementielle qui mouline à l'infini

Bonjour,

Dans le but d’aider un autre membre (fil en cours : https://forum.excel-pratique.com/excel/fichier-de-calcul-pour-jours-d-arret-de-travail-t24592.html), j’ai tenté la macro événementielle ci-jointe.

En l’état actuel des choses, cette macro événementielle fonctionne parfaitement si je calcule une seule ligne. Par exemple, si j’inscris 18.04.2012 dans la cellule B6, les fonctions placées en C6 et E6 jouent leur rôle et ma macro calcule le bon résultat en D6 (135).

Par contre, je voudrais que la colonne F - utilisée provisoirement – soit effacée à la fin du code. Par sécurité, j’aurais également voulu effacé cette colonne en début de macro afin d’être certain qu’il n’y ait pas de problème de chiffres qui y soient inscrits et qui fassent interférence aux calculs placés dans la macro.

Mais si j’active l’un ou l’autre des deux codes Columns("F:F").ClearContents mis en place - mais actuellement neutralisés - ma macro tourne indéfiniment dans le vide.

Pouvez-vous m’aider à corriger ce code ?

NB : Mon code fonctionne également bien pour n'importe quelle ligne si j'efface manuellement la colonne F avant d'inscrire une nouvelle date dans une cellule quelconque de la colonne B.

Bonnes salutations.

Bonsoir

Devant le 1er

Columns("F:F").ClearContents

rajoutes

If Target.Count > 1 Then Exit Sub

Salut Banzai,

Merci pour ta proposition.

Ca ne fonctionne cependant pas comme désiré (ou alors je n'ai pas compris tes explications). Dans le fichier ci-joint Papy_V4, lorsque j'inscris 18.04.2012 en B6, j'obtiens le résultat de 150 en D6, alors que - tel que visible sur l'image du fichier Papy_V2 qui y est insérée - je devrais obtenir 135.

Cela provient, je présume, du fait que ma colonne F - utilisée provisoirement par ma macro - est effacée à chaque boucle du passage For Next au lieu de n'être effacée qu'à la fin et au début de la macro.

A tout hasard, je joins également mon fichier Papy_V2 qui contient une autre macro qui donne les résultats désirés. Dans cette version, il faut cependant lancer la macro par un bouton et tous les calculs de la colonne D sont à chaque fois refaits.

J’espère que toi ou quelqu'un d'autre puisse encore m'aider.

Bonnes salutations

Bonjour à tous,

Je n'ai regardé que ton premier fichier. C'est une situation assez récurrente. Il faut désactiver les évènements au début du code et les réactiver à la fin.

Place ce code au début :

Application.EnableEvents = False

et celui-ci à la fin :

Application.EnableEvents = True

Comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dernière_Ligne As Integer, Date_prise_en_compte As Date
Dim i As Integer

Application.ScreenUpdating = False
Application.EnableEvents = False
Columns("F:F").ClearContents

If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
    Dernière_Ligne = Target.Row
    Date_prise_en_compte = Target.Offset(0, 3)

    For i = 2 To Dernière_Ligne
        If Cells(i, 2) >= Date_prise_en_compte Then
            Cells(i, 6) = Cells(i, 2) - WorksheetFunction.Max(Cells(i, 1), Date_prise_en_compte) + 1
        End If
    Next

    Cells(Dernière_Ligne, 4) = 150 - WorksheetFunction.Sum(Range("F2:F1000"))

End If

Columns("F:F").ClearContents

Columns("F:F").NumberFormat = "0" 'provisoire
Application.EnableEvents = True
End Sub

Bonjour à tous,

Le problème lorsqu'on désactive les évenementielles , si pour une raison quelqu'on le programme plante,

il faut réactiver les évenementielles autrement que par le code prévu à cet effet .

enfin ce n'est qu'une philosophie, un peu comme l'emploi de on error pour detecter si un onglet existe ....

Voilà donc une solution mois radicale mais tout aussi efficace .

il suffit alors de positionner le drapeau pour autoriser ou pas d'une façon plus sélective l'utilisation des évenementielles ...

Dans un module standard
Public Débraye as boolean

et dans l'évenementiel concerné

If not Débraye then 

Traitement

end if

AJOUT du fichier modifé ...

Bonsoir

Juste pour dire, Comme tes calculs n'affectent pas la colonne B, qu'en modifiant la macro, c'est à dire en incluant les

Columns("F:F").ClearContents

dans la condition If ... End If

ET en mettant

If Target.Count > 1 Then Exit Sub

on évite l'emploi de

Application.EnableEvents = False
'
'
'
Application.EnableEvents = True

Qui peut des fois être gênant

essayes d'effacer une cellule en colonne B : La macro plante (dans tous les cas)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dernière_Ligne As Integer, Date_prise_en_compte As Date
Dim i As Integer

  Application.ScreenUpdating = False

  If Target.Count > 1 Then Exit Sub
  If Not Application.Intersect(Target, Range("B2:B1000")) Is Nothing Then
    Columns("F:F").ClearContents
    Dernière_Ligne = Target.Row
    Date_prise_en_compte = Target.Offset(0, 3)

    For i = 2 To Dernière_Ligne
      If Cells(i, 2) >= Date_prise_en_compte Then
        Cells(i, 6) = Cells(i, 2) - WorksheetFunction.Max(Cells(i, 1), Date_prise_en_compte) + 1
      End If
    Next

    Cells(Dernière_Ligne, 4) = 150 - WorksheetFunction.Sum(Range("F2:F1000"))
    Columns("F:F").ClearContents
  End If
End Sub

C'est vrai elle est moins rapide que celle de Vba-news ( imperceptible)

Mais plus sure car en cas de plantage pas besoin de réinitialiser les évènements

Mais j'emploie assez souvent les Application.EnableEvents

A voir la solution de Misterno

Salut

et ainsi ?

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Dates As Date, Li As Long, T As Long
  If Target.Count > 1 Or Intersect(Target, Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then Exit Sub
  Dates = Target.Offset(, 3)
  For Li = 2 To Target.Row
    If Cells(Li, 2) >= Dates Then
      T = T + Cells(Li, 2) - Application.Max(Cells(Li, 1), Dates) + 1
    End If
  Next
  Target.Offset(, 2) = 150 - T
End Sub

Bonjour à tous et merci pour vos nombreuses réponses

Vba-new : Ton code fonctionne bien en ce qui concerne le calcul. Par contre c’est vrai que si efface une cellule ça plante et ensuite plus rien ne fonctionne (et personnellement je ne sais pas réactiver les événementielles «manuellement»).

Misterno : Ton code fonctionne bien en ce qui concerne le calcul, mais si j’efface une cellule de la colonne B, ça plante également.

Banzai : Effectivement que – comme tu me l’indiques – malgré la modification que tu as apportée, le code plante si on efface une cellule en colonne B.

BonUs : Ton code fonctionne parfaitement au niveau du calcul, mais il plante également si on efface une cellule de la colonne B.

Lors de mes nombreux essais de vos propositions ci-dessus, je me rends compte qu’il est incorrect de ne déclencher la macro événementielle que lors de la modification des cellules de la colonne B. En effet, si l’on corrige par la suite une cellule de la colonne A, il faudrait également que le calcul de la colonne D soit corrigé.

Au cas où l’un de vous trouvait une solution au problème d’effacement des cellules, ce serait bien d’inclure la modification de la colonne A.

A vous relire.

Bonjour à tous,

Misterno a écrit :

Le problème lorsqu'on désactive les évenementielles , si pour une raison quelqu'on le programme plante,

il faut réactiver les évenementielles autrement que par le code prévu à cet effet .

Une solution : utiliser une formule

Désactive ta macro évènementielle et mets la formule matricielle suivante en D2 :

=150-SOMMEPROD(($B$2:B2>E2)*(($B$2:B2)-SI($A$2:A2>E2;$A$2:A2;E2)+1))

Formule à valider par CTRL+MAJ+ENTRÉE et à tirer vers le bas.

Sinon si tu veux rester avec une macro, utilise une variable tableau plutôt que de modifier directement la colonne F.

Bonjour,

Essaie comme ceci

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dernière_Ligne As Integer, Date_prise_en_compte As Date
Dim i As Integer
Application.ScreenUpdating = False
If ok = True Then Exit Sub
ok = True
Columns("F:F").ClearContents
If Not Application.Intersect(Target, Range("A2: B1000")) Is Nothing Then
    Dernière_Ligne = Target.Row
    If IsDate(Target.Offset(0, 3)) Then Date_prise_en_compte = Target.Offset(0, 3)
    For i = 2 To Dernière_Ligne
        If Cells(i, 2) >= Date_prise_en_compte And Cells(i, 2) <> "" Then
            Cells(i, 6) = Cells(i, 2) - WorksheetFunction.Max(Cells(i, 1), Date_prise_en_compte) + 1
        End If
    Next
    Cells(Dernière_Ligne, 4) = 150 - WorksheetFunction.Sum(Range("F2:F1000"))
End If
'Columns("F:F").ClearContents
Columns("F:F").NumberFormat = "0" 'provisoire
ok = False
End Sub

Mettre également dans un module --> Public ok as boolean

cela suppose que la colonne A n'est jamais vide.

Amicalement

Bonjour

Mon idée

A tester

Bonjour à vous tous,

A nouveau merci pour vos nombreuses réponses.

@ Vba-new

J’avais tout d’abord indiqué – sur l’autre fil parallèle – à Papydydy qu’il me semblait impossible d’arriver à obtenir le résultat voulu sans passer par une macro. Tu nous prouves là le contraire : chapeau ! J’ai simplement proposé à Papydydy d’ajouter une condition au début de ta formule afin que les cellules dans lesquelles se trouve cette formule ne renvoient pas de valeur si les colonnes A, B et C sont vides. Par contre je n’ai pas compris pourquoi tu indiques de valider la formule par CTRL+MAJ+ENTRÉE ; selon moi ça fonctionne tout autant sans.

@ Dan

Après que j’y ai réactivé la deuxième ligne Columns("F:F").ClearContents afin que les calculs de la colonne F ne restent pas visibles sur la feuille, ton code fonctionne parfaitement.

@ Banzai

Ta solution fonctionne également parfaitement. Le petit plus dans ta solution est que les colonnes C, D et E se vident si une date est effacée dans la colonne A ou dans la colonne B.

Vous avez tous été géniaux

Bonnes salutations à vous tous.

Yvouille a écrit :

Par contre je n’ai pas compris pourquoi tu indiques de valider la formule par CTRL+MAJ+ENTRÉE ; selon moi ça fonctionne tout autant sans

Yvouille a écrit :

Par contre je n’ai pas compris pourquoi tu indiques de valider la formule par CTRL+MAJ+ENTRÉE ; selon moi ça fonctionne tout autant sans.

Oh la la ! J'ai un peu créé des problèmes avec ces deux fils parallèles

Et c'est vrai que je n'ai étudié en détail ni ta formule, ni celle que Papydydy a trouvé sur un autre Forum et que j'ai pris pour la tienne.

Absolument désolé

Encore merci à toi pour ta peine.