Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"

pat66 · Mercredi à 11:21

Bonjour le forum,

je tente désespérément de rédiger cette macro, mais je n'y arrive pas, auriez vous la gentillesse de bien vouloir m'aider à rectifier cette macro, merci beaucoup !

Dans la cellule verrouillée de Worksheets("Données").Range("N6"), il y a cette formule qui fonctionne bien :
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100

mais il faudrait pouvoir alterner à chaque clic sur une forme, entre 2 formules à savoir :

La formule originale dans Worksheets("Données").Range("N6")
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100

Au 1er clic, réduire le résultat dans N6 de 0.20%
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100

2e Clic : revenir à la formule originale

etc ...

merci d'avance

Sub ChangeTaux()
Dim tauxActuel As Double
Static tauxOriginal As Variant ' variable persistante entre exécutions

With Worksheets("Données").Range("N6")
tauxActuel = .Value
If IsEmpty(tauxOriginal) Then
' Premier clic : on enregistre le taux initial et on le réduit de 0,20 point de pourcentage
tauxOriginal = tauxActuel
.Value = tauxActuel - 0.002
Else
' Second clic : on rétablit le taux original et on réinitialise la variable
.Value = tauxOriginal
tauxOriginal = Empty
End If
End With
End Sub

sylvanu · Hier à 13:16

Re,
Comme je n'ai aucune idée sur l'origine du problème puisque c'est ok chez moi , une PJ avec encore plus simple :

VB:

Sub Réduction()
If [B7] = 0 Then [B7] = 0.002 Else [B7] = 0
[B7].NumberFormat = """Réduction : ""0.0%"
End Sub

La formule devient :

Code:

=-B7+SI(K6=1;INDEX(F11:O15;EQUIV(M6-0.0001;E11:E15;1);EQUIV(I6-0.0001;F10:O10;1)+1);INDEX(F17:O21;EQUIV(M6-0.0001;E17:E21;1);EQUIV(I6-0.0001;F10:O10;1)+1))/100

B7 étant la réduction appliquée.

cathodique · Mercredi à 12:07

Bonjour,

La solution est dans le titre de ta demande "Basculer" ===> utiliser un bouton à Bascule.
à tester

VB:

Private Sub ToggleButton1_Click()
    Dim tauxActuel As Double
    Static tauxOriginal As Variant ' variable entre exécutions

    With Worksheets("Données").Range("N6")
        tauxActuel = .Value
        
        If ToggleButton1.Value = True Then
            ' Premier clic
            If IsEmpty(tauxOriginal) Then
                tauxOriginal = tauxActuel
                .Value = tauxActuel - 0.002
            End If
        Else
            ' Second clic
            .Value = tauxOriginal
            tauxOriginal = Empty
        End If
    End With
End Sub

Bonne journée.

pat66 · Mercredi à 12:59

bonjour,

j'ai du mal m'exprimer car cette solution ne mémorise pas la formule existante dans N6, elle a les mêmes propriétés que le sub saisit sur post#1

peut être en utilisant formula local ???

Or, je souhaite conserver la formule originale dans N6 =@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100

Au 1er clic, réduire le résultat dans N6 de 0.20%
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100 ( résultat - 0.20%)

Au 2e clic, on revient à la formule originale
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100 (formule originale toujours présente dans N6)

cathodique · Mercredi à 17:34

pat66 à dit:
bonjour,

j'ai du mal m'exprimer car cette solution ne mémorise pas la formule existante dans N6, elle a les mêmes propriétés que le sub saisit sur post#1

peut être en utilisant formula local ???

Or, je souhaite conserver la formule originale dans N6 =@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100

Au 1er clic, réduire le résultat dans N6 de 0.20%
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100 ( résultat - 0.20%)

Au 2e clic, on revient à la formule originale
=@SI(I16=1;INDEX(AE7:AM11;EQUIV(K16-0,0001;AD7:AD11;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1);INDEX(AE13:AM17;EQUIV(K16-0,0001;AD13:AD17;1);EQUIV(N8*12-0,0001;AE6:AM6;1)+1))/100 (formule originale toujours présente dans N6)

sans fichier je ne peux plus t'aider.

pat66 · Hier à 09:53

bonjour,

voila le fichier, j'espère être explicite, pour l'exemple sur le fichier, j'ai du modifié les cellules concernées par rapport au #post 1

un grand merci

sylvanu · Hier à 10:56

Bonjour Pat, Cathodique,
Peut être avec simplement :

VB:

Sub Réduction()
Dim F$
F = [B6].FormulaLocal
If Left(F, 3) = "=0%" Then
    F = Replace(F, "=0%", "=-0.2%")
Else
    F = Replace(F, "=-0.2%", "=0%")
End If
[B6].FormulaLocal = F
End Sub

NB : J'ai modifié la formule en B6 : =0%+SI(K6=1;INDEX....

sylvanu · Hier à 11:11

Re,
Cependant je trouve que votre fichier a un défaut.
Si vous l'ouvrez et cliquez, cliquez cliquez sur ce bouton, puis enregistrez le fichier, quand vous l'ouvrez vous ne saurez pas si la réduction a lieu ou pas.
Peut être est ce judicieux de signaler si le taux fait l'objet d'une réduction ou pas. Avec :

VB:

Sub Réduction()
Dim F$
F = [B6].FormulaLocal
If Left(F, 3) = "=0%" Then
    F = Replace(F, "=0%", "=-0.2%")
    [B7] = "Réduction appliquée"
Else
    F = Replace(F, "=-0.2%", "=0%")
    [B7] = "Pas de éduction"
End If
[B6].FormulaLocal = F
End Sub

pat66 · Hier à 11:31

Bonjour Sylvanu,

Très bonne idée cependant lorsque je clique sur le bouton j'ai ce message d'erreur qui stoppe la macro

sylvanu · Hier à 11:49

Re,
Je n'ai pas ça sur mon PC.

C'est bien avec la PJ que vous avez testé ?

pat66 · Hier à 11:57

re,

oui la V2 du post "7

peut être un paramètres d'Excel à modifier ? qu'en pouvez vous ?

sylvanu · Hier à 12:34

Re,
Non, rien de spécial.
Testez cette PJ.
Je met la formule en B2, suivant les clics vous devriez avoir :

VB:

soit
=0%+SI(K6=1;INDEX(F11:O15;EQUI ....
soit
=-0.2%+SI(K6=1;INDEX(F11:O15;EQUI ....

sinon dites moi ce que vous avez en B2.

pat66 · Hier à 12:43

re,

alors le message change bien à chaque clic Réduction appliquée ou Pas de réduction, mais le taux ne change pas et la macro n'affiche plus d'erreur

Dans b2 :
'=-0.2%+SI(K6=1;INDEX(F11:O15;EQUIV(M6-0.0001;E11:E15;1);EQUIV(I6-0.0001;F10:O10;1)+1);INDEX(F17:O21;EQUIV(M6-0.0001;E17:E21;1);EQUIV(I6-0.0001;F10:O10;1)+1))/100
ou
'=0%+SI(K6=1;INDEX(F11:O15;EQUIV(M6-0.0001;E11:E15;1);EQUIV(I6-0.0001;F10:O10;1)+1);INDEX(F17:O21;EQUIV(M6-0.0001;E17:E21;1);EQUIV(I6-0.0001;F10:O10;1)+1))/100

sylvanu · Hier à 13:16

Re,
Comme je n'ai aucune idée sur l'origine du problème puisque c'est ok chez moi , une PJ avec encore plus simple :

VB:

Sub Réduction()
If [B7] = 0 Then [B7] = 0.002 Else [B7] = 0
[B7].NumberFormat = """Réduction : ""0.0%"
End Sub

La formule devient :

Code:

=-B7+SI(K6=1;INDEX(F11:O15;EQUIV(M6-0.0001;E11:E15;1);EQUIV(I6-0.0001;F10:O10;1)+1);INDEX(F17:O21;EQUIV(M6-0.0001;E17:E21;1);EQUIV(I6-0.0001;F10:O10;1)+1))/100

B7 étant la réduction appliquée.

cathodique · Hier à 13:16

Bonjour, @sylvanu 😉,

J'espère que ça répondra à ta demande avec un bouton bascule.
Code dans ThisWorkBook

VB:

Option Explicit

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Set ws = Worksheets("Données")

    ' Vérifier si B6 contient une formule
    If ws.Range("B6").HasFormula Then
        ws.OLEObjects("ToggleButton1").Object.Caption = "Sans Réduction"
    Else
        ws.OLEObjects("ToggleButton1").Object.Caption = "Avec Réduction"
    End If
End Sub

et code pour le ToggleButton (c'est un ActiveX)

VB:

Option Explicit

Private Sub ToggleButton1_Click()
    Dim ws As Worksheet
    Set ws = ActiveSheet
   
    Static isReduced As Boolean ' Variable pour suivre l'état de la réduction
    Dim formuleOriginale As String
   
    ' Conserver la formule originale dans une variable
    formuleOriginale = "=IF(K6=1, INDEX(F11:O15, MATCH(M6-0.0001, E11:E15, 1), MATCH(I6-0.0001, F10:O10, 1)+1), INDEX(F17:O21, MATCH(M6-0.0001, E17:E21, 1), MATCH(I6-0.0001, F10:O10, 1)+1))/100"
   
    ' Vérifier l'état du ToggleButton
    If Not isReduced Then
        ' Premier clic : appliquer la réduction de 0,20%
        ws.Range("B6").Formula = formuleOriginale
        Dim tauxActuel As Double
        tauxActuel = ws.Range("B6").Value
        ws.Range("B6").Value = tauxActuel - (tauxActuel * 0.002)
        ToggleButton1.Caption = "Avec Réduction"
        isReduced = True
    Else
        ' Second clic : restaurer la formule originale
        ws.Range("B6").Formula = formuleOriginale
        ToggleButton1.Caption = "Sans Réduction"
        isReduced = False
    End If
End Sub

pat66 · Hier à 13:34

re,

Sylvanu, votre solution correspond exactement à ce dont j'avais besoin, un grand merci, rien ne vous résiste !!!!

Cath, ta solution est intéressante mais la solution de Sylvanu est vraiment beaucoup plus simple pour moi, je la garde au chaud pour une autre fois, un grand merci pour ton aide

cdt

Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"

pat66

XLDnaute Impliqué

sylvanu

cathodique

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

cathodique

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Pièces jointes

sylvanu

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Microsoft 365 macro qui permet de basculer entre 2 valeurs composées de formules de type "Formula local"

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Privacy & Transparency

Privacy & Transparency