Somme à chaque nouvel clique (2)

[apt]

Bonsoir à tous,

Suite à ce post :

http://www.developpez.net/forums/d11...nouvel-clique/

Je voulais adapter le code suivant, mais sans succés :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
Private Sub ToggleButton1_Click()
    ToggleButton1.Caption = IIf(ToggleButton1.Value, "Calcul de somme active, Stopper ?", "Stop")
    If Not ToggleButton1.Value Then [J2].Value = 0
End Sub
 
Private Sub Worksheet_Activate()
    ToggleButton1.Value = False
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
 
    If ToggleButton1.Value And (Target.Count = 1) Then
        If Not Intersect(Target, Range("H2")) Is Nothing Then
            Auto_Filter
        End If
        If Not Intersect(Target, Range("G3:G65000")) Is Nothing Then
            [J2].Value = [J2].Value + Target.Value    'Sommer ce qui est saisie
        End If
    End If
    Application.EnableEvents = True
End Sub

Dans module1 :

Code :

1
2
3
4
5
6
7
8
9
Option Explicit
 
Sub Auto_Filter()
    Dim X As String
    Application.ScreenUpdating = False
    X = Range("I1").Value
    Range("A2:G2").AutoFilter Field:=6, Criteria1:=X
    Application.ScreenUpdating = True
End Sub

Avec I2 ="*"&H2&"*"

Merci d'avance.

[apt]

Bonjour,

Un autre essai avec ce code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Option Explicit
Private Sub ToggleButton1_Click()
    With ToggleButton1
        If .Value = True Then
            .BackColor = RGB(255, 0, 0)    'Rouge
            .Caption = "STOP"
        ElseIf .Value = False Then
            .Caption = "Calcul salaires"
            .BackColor = RGB(0, 255, 0)    'Vert
 
            'Mettre à zéro la somme
            With Sheets("Feuil2")
                .Range("I2").Value = 0
            End With
        End If
    End With
End Sub
Private Sub Worksheet_Activate()
    ToggleButton1.Value = False
    If AutoFilterMode = True Then
        ActiveSheet.ShowAllData
    End If
    Range("I2").Value = 0
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim X As String
    Application.ScreenUpdating = False
    If Not Intersect(Target, [H2]) Is Nothing Then
        ' Critère du filtre
        X = Range("H2").Value
        ' Zone du filtre
        If AutoFilterMode = False Then
            Range("A2:G2").AutoFilter
        End If
        ' Filtre sur le critère
        With Range("A2:G2")
            .AutoFilter field:=6, Criteria1:="*" & X & "*"
        End With
    End If
    Application.EnableEvents = False
    If Not Intersect(Target, Range("G2:G" & Range("G65000").End(xlUp).Row)) Is Nothing _
       And ToggleButton1.Value Then
        If IsNumeric(Target.Value) Then [I2].Value = [I2].Value + Target.Value
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Mais parfois j'ai un problème avec :

Application.EnableEvents qui est à False ce qui cause le non deroulement normal du code (AutoFilter).

[BlueMonkey]

Re.

J'ai rassemblé les différents éléments, sans voir de problème avec le code #2.
Mais le problème à pu m'échapper.

Mais parfois j'ai un problème avec Application.EnableEvents

Quel est exactement le problème ? Quel est sont symptôme ?
Dans quel cas il se reproduit ?

Et une explication sur le comportement attendu des nouvelles fonctionnalités sont les bienvenue également.

Bonne nuit.

P.S. : Un conseil pour obtenir de l'aide :
d'une façon générale, répondre aux questions ci-dessus dès le premier post aide à avoir des réponses.
La majorité des helpeurs sont découragés s'ils doivent décoder un code de plusieurs fonctions, pour comprendre ce que l'utilisateur final souhaite).
C'est probablement pour ça qu'il n'a pas eut de réponse jusque là.

[apt]

Bonsoir BlueMonkey,

Je crois que le problème vient de la non gestion des erreurs.

Parce que parfois je me trouve travailler avec quelques classeurs ouverts en même temps.

Lorsque j'essaye un par exemple et le code plante, les événements ne sont pas remis à Application.EnableEvents = True

C'est pour cela, enfin je crois, que lorsque je voudrais essayer d'autres codes, il se trouve que Application.EnableEvents est encore à False depuis l'exécution de premier code qui a planté.

Mais, vois-tu, je ne sais pas gérer les erreurs et les effacer au moment opportun.

Voila

[BlueMonkey]

Bonsoir,

Je ne sais pas gérer les erreurs et les effacer au moment opportun.

En cours de développement, il arrive couramment qu'un programme "plante".
Il faut alors contrôler la validité des éléments qui servent de paramètre d'entrée au code. (tests avec IF ...)
Dans le cas où les erreurs d'exécution ne peuvent être empêchée, ou que la prise en compte de tous les cas possible est trop lourde,
il est possible d'intercepter les erreurs (voir Faq Gestion des erreurs par SilkyRoad )

L'important est d'aboutir à un code qui est stable en fin de développement, et qu'il soit suffisamment "cloisonné" pour que les développements
futur sur le même code ne perturbe pas sa stabilité.
(utilisation de fonction, de modules, voir des modules de classe).

Pour le cas particulier du Application.EnableEvents = false, je dirais que si on part du principe qu'un bon code ne sélectionne que
rarement une feuille (en VBA on peut travailler sur une feuille sans la sélectionner),
je dirais qu'en cours de débuggage d'ajouter une fonction dans les feuilles :

Code :

1
2
3
Private Sub Worksheet_Activate()
    Application.EnableEvents = True
End Sub

Ca réactivera les évènements chaque fois que tu changeras d'onglet.

[apt]

Bonsoir BlueMonkey,

Ok !

Je vais lire le document de SilkyRoad

en VBA on peut travailler sur une feuille sans la sélectionner

Je lis souvent cette phrase sans bien la rendre pratique