Problème de compteur

Magic_Doctor · 21 Avril 2016

Bonjour,

Sur ma feuille j'ai une cellule ("C9") dans laquelle je rentre soit 0, soit une valeur <> 0.
Ailleurs, sur la même feuille, j'ai une cellule ("B11") qui déclenche, lorsque l'on clique dessus, une macro événementielle qui n'est opérationnelle que si dans la cellule précédente il y a une valeur > 0 (si 0, cellule bloquée) ; autrement dit :
- si [C9] = 0 --> la macro événementielle est bloquée,
- si [C9] <> 0 --> la macro événementielle est opérationnelle.

GESTION DE L'AFFAIRE :

- module de feuille :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target, [B11]) Is Nothing Then
        If [C9] = 0 Then Exit Sub   'pour rendre inopérationnelle la macro événementielle
        Application.ScreenUpdating = False
        Sheets("BTX").Unprotect MotDePasse
        Modif_Cel_Reconstitution
        Sheets("BTX").Protect MotDePasse, True, True, True
        [AZ1].Select: Application.ScreenUpdating = True
    End If

End Sub

- module standard :

VB:

Sub Modif_Cel_Reconstitution()
'job75

    compt1 = IIf(IsNumeric(Evaluate("Compteur1")), Evaluate("Compteur1"), 0)
    compt1 = IIf(compt1 < 2, compt1 + 1, 1)
    ActiveWorkbook.Names.Add Name:="Compteur1", RefersTo:=compt1, Visible:=False
    
    If compt1 = 1 Then
      blablabla
    else
      chabada
    endif

End Sub

En conséquence :
- je clique une première fois sur la cellule "B11" --> compt1 = 1 + blablabla
- je clique à nouveau sur la même cellule --> compt1 = 2 + chabada

Maintenant, je rentre la valeur 0 dans la cellule "C9" (ce qui va fatalement bloquer la macro événementielle).
Si, avant de rentrer cette valeur compt1 = 1 --> pas de problème par la suite.
En revanche si compt1 = 2 --> problème par la suite.

Ce que je voudrais, c'est quand on met 0 et que compt1 = 2, automatiquement compt1 = 1.

J'ai essayé depuis un bon moment, mais n'y suis pas parvenu.

Merci d'avance pour tout conseil.

CISCO · 21 Avril 2016

Re : Problème de compteur

Bonjour

Est-ce que tu as essayé avec
If compt1 = 2 And [C9]= 0 Then compt1 = 1

@ plus

Magic_Doctor · 21 Avril 2016

Re : Problème de compteur

Bonsoir Cisco,

J'avais essayé sans succès...
J'avais pensé à la chose suivante : compt1 = 2 et [C9] = 0 --> [B11].Activate (pour passer à compt1 = 1).
Le problème, c'est que je suis bloqué, puisque quand [C9] = 0 on court-circuite la macro événementielle.
Un vrai casse-tête !

job75 · 21 Avril 2016

Re : Problème de compteur

Bonjour Magic_Doctor, CISCO,

Si j'ai bien compris :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Not Intersect(Target, [B11]) Is Nothing Then
        If [C9] = 0 Then Modif_Cel_Reconstitution True: Exit Sub
        Application.ScreenUpdating = False
        Sheets("BTX").Unprotect MotDePasse
        Modif_Cel_Reconstitution
        Sheets("BTX").Protect MotDePasse, True, True, True
        [AZ1].Select: Application.ScreenUpdating = True
    End If

End Sub

Code:

Sub Modif_Cel_Reconstitution(Optional bloque As Boolean = False)
'job75

    compt1 = IIf(IsNumeric(Evaluate("Compteur1")), Evaluate("Compteur1"), 0)
    compt1 = IIf(compt1 < 2 And Not bloque, compt1 + 1, 1)
    ActiveWorkbook.Names.Add "Compteur1", compt1, Visible:=False
    If bloque Then Exit Sub
    If compt1 = 1 Then
      'blablabla
    Else
      'chabada
    End If

End Sub

Pas trop casse-tête ?

A+

Magic_Doctor · 21 Avril 2016

Re : Problème de compteur

Bonjour job,

Merci pour ta réponse, je n'y aurais pas pensé !
C'est presque gagné. Il demeure néanmoins un petit problème.
J'ai passé un bon moment à "résumer" mon application pour qu'il n'y ait que l'essentiel concernant ma requête.
Tout est expliqué, pas à pas, dans la feuille.

PS : mot de passe "zaza" (tout en minuscule)

job75 · 21 Avril 2016

Re : Problème de compteur

Re,

Magic_Doctor à dit:
C'est presque gagné. Il demeure néanmoins un petit problème.

Bah on pourrait en découvrir d'autres...

Dans la macro Worksheet_Change essaie ceci :

Code:

'-----
        If [C9] = 0 Then
            With Selection
                .HorizontalAlignment = xlRight 'justification à droite
                .Font.Color = 12611584 'reprend sa couleur d'origine
            End With
        Else
            With Selection
                .HorizontalAlignment = xlCenter 'centré
                .Font.Color = 614601 'prend une couleur terre de sienne des Antilles de l'Est
            End With
            ThisWorkbook.Names.Add "Compteur1", 0
            Modif_Cel_Reconstitution
        End If

A+

Magic_Doctor · 21 Avril 2016

Re : Problème de compteur

Re,

Je viens d'essayer. À moins que je me sois planté quelque part, ça ne marche toujours pas...

job75 · 22 Avril 2016

Re : Problème de compteur

Bonjour Magic_Doctor, le forum,

Tu n'as pas appliqué à Worksheet_Change la modif que j'ai indiquée au post #6 !!??

Cela dit l'appel de Modif_Cel_Reconstitution ne paraît pas nécessaire, complète plutôt ainsi :

Code:

'---------
        ThisWorkbook.Names.Add "Compteur1", IIf([C9] = 0, 2, 1), Visible:=False
        compt1 = IIf([C9] = 0, 2, 1)
        Modif_Tableaux_Reconstitution 'mises en forme des tableaux "RECONSTITUTION"

Bonne journée.

job75 · 22 Avril 2016

Re : Problème de compteur

Re,

Chez moi la modification de la cellule C9 prend 3 à 4 secondes, c'est pénible !

C'est dû aux nombreuses déprotections/protections de la feuille par tes macros.

Neutralise donc tous tes codes (dans tous les modules) qui déprotègent et protègent la feuille.

Et place au début des macros Worksheet_Change et Worksheet_SelectionChange :

Code:

Me.Protect MotDePasse, UserInterfaceOnly:=True

Chez moi la modification de C9 se fait alors en 1/10ème de seconde...

A+

Magic_Doctor · 22 Avril 2016

Re : Problème de compteur

Bonsoir job,

J'ai dû me mélanger les pinceaux en ouvrant 2 classeurs identiques, mais avec des noms différents, de telle sorte que j'utilisais un classeur, alors que la macro avait été modifiée dans l'autre classeur. Voilà pourquoi les modifications que tu avais apportées me semblaient ne pas marcher.

Changer :

VB:

ActiveWorkbook.Names.Add "Compteur1", compt1, Visible:=False

par :

VB:

ThisWorkbook.Names.Add "Compteur1", IIf([C9] = 0, 2, 1), Visible:=False
compt1 = IIf([C9] = 0, 2, 1)

fait que ça me semble plus clair maintenant.

Tu as raison, appeler "Modif_Tableaux_Reconstitution" était tout à fait inutile, puique on l'appelle par la suite.
En revanche, j'ai dû substituer "Modif_Tableaux_Reconstitution" par une petite routine pour la mise en forme des 2 tableaux "RECONSTITUTION" lors de leur ouverture après avoir entré une valeur <> 0 pour le "Facteur de diffusion" (après un compt1 = 2), sinon, esthétiquement parlant, c'était pas terrible.

Revoir en détail l'application, m'a permis d'alléger quelques "lourdeurs".

Subsiste un dernier (je pense cette fois !) problème.
Tout marche très bien, à un détaille près :
Le "Facteur de diffusion" est <> 0.
On clique sur "RECONSTITUTION" (compt1 = 2) pour contracter les 2 tableaux "RECONSTITUTION" (2 lignes).
On rentre une nouvelle valeur (<> 0) pour le "Facteur de diffusion", les 2 tableaux "RECONSTITUTION" se déploient d'une manière tronquée (4 lignes), alors que je voudrais qu'ils restent contractés (2 lignes) ou, si tu préfès, qu'ils soient figés.

Merci pour ton aide toujours précieuse.

Muy buenas noches

Magic_Doctor · 23 Avril 2016

Re : Problème de compteur

Bonsoir job,

Pas vu ton dernier message (post #9), je n'avais pas rafraîchi l'écran.

Tu as raison, il y a beaucoup de "protections-déprotections". Dans la dernière PJ tu verras que j'en ai viré une palanquée dans le module standard "Macros_Calculs". C'est vrai que ces trucs-la ça doit faire perdre pas mal de temps. Je m’étais en effet rendu compte d’une certaine lenteur que j’attribuais à l’âge de ma bécane.
J’ai donc viré ce qui restait des "protections-déprotections" pour placer "Me.Protect MotDePasse, UserInterfaceOnly:=True" là où tu m’as dit.
Pas mal ce truc-la " Me.Protect MotDePasse, UserInterfaceOnly:=True " !

Bon, dernière version améliorée.

job75 · 23 Avril 2016

Re : Problème de compteur

Bonjour Magic_Doctor, le forum,

Tu n'avais pas mis ma modif du post #8 à l'endroit indiqué mais bon...

De toute façon supprime-la et introduit celle-ci (au bon endroit) :

Code:

'-----
        If IsError([memFD]) Then ThisWorkbook.Names.Add "memFD", 0
        If [memFD] = 0 And [C9] <> 0 Then
          ThisWorkbook.Names.Add "Compteur1", 1, Visible:=False
          compt1 = 1
        End If
        ThisWorkbook.Names.Add "memFD", [C9].Value, Visible:=False 'mémorisation

        Modif_Tableaux_Reconstitution 'mises en forme des 2 tableaux "RECONSTITUTION"

Fichier joint.

Bonne journée.

job75 · 24 Avril 2016

Re : Problème de compteur

Bonjour Magic_Doctor, le forum,

Autant utiliser l'astuce de mon post #4 :

Code:

'-----
        'mise à jour du compteur en fonction de la valeur précédente de C9
        If IsError([memFD]) Then ThisWorkbook.Names.Add "memFD", 0
        If [memFD] = 0 And [C9] <> 0 Then Modif_Cel_Reconstitution True
        ThisWorkbook.Names.Add "memFD", [C9].Value, Visible:=False 'mémorisation
        
        Modif_Tableaux_Reconstitution 'mises en forme des 2 tableaux "RECONSTITUTION"

Edit : j'initialise aussi compt1 dans ThisWorkbook, c'est utile :

Code:

Private Sub Workbook_Open()
If IsNumeric([Compteur1]) Then compt1 = [Compteur1]
End Sub

C'est même pour faire ça que le nom "Compteur1" est créé !

Fichier (4).

Bonne journée.

Magic_Doctor · 26 Avril 2016

Re : Problème de compteur

Bonsoir job,

Pas pu répondre avant, problèmes de connexion. Ici, en ce moment, le temps est épouvantable... Comme dab !
En attendant une meilleure connexion, j'ai amélioré certaines macros et réglé un problème de "look" quand on rentre une nouvelle valeur en [C9] et que les tableaux "RECONSTITUTION" sont contractés.

J'ai fait les modifications comme mentionnées dans ton dernier post.
TOUT semble enfin fonctionner à merveille !

Mais enfin, quand même, c'était une aventure... ;=)

Un grand merci pour ton aide indispensable.

Muy buenas noches

Problème de compteur

Magic_Doctor

XLDnaute Barbatruc

CISCO

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Magic_Doctor

XLDnaute Barbatruc

Pièces jointes

Discussions similaires