Activer et désactiver une macro en cour avec des shapes

Bonjour,

J'ai crée une dizaine de formes rectangles, aux quels j'affecte une macro.

Cette macro à pour objectif de modifier un graphie selon des paramètres donnés.

Dans le même temps, je souhaite que le rectangle change de couleur quand j'active la macro en cliquant sur le bouton, et je souhaite que la couleur change encore quand je clique sur un autre bouton afin de changer mon graphique avec d'autres paramètres.

Pour le moment, je suis obliger de recliquer sur le bouton pour faire revenir la couleur initiale.

Voici l'ensemble du code :

` cet première partie concerne le calcul.

Application.ScreenUpdating = False
Range("K3").Select
ActiveCell.FormulaR1C1 = "=90%*RC[4]"
Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K35")
Range("K3:K35").Select
Range("M3").Select
ActiveCell.FormulaR1C1 = "=10%*RC[2]"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M35")
Range("M3:M35").Select
Application.ScreenUpdating = True

'Ici je veux changer la couleur. Mais pour le moment, pour que la couleur revienne à la normale, je dois recliquer dessus. Or je veux que la couleur se remette toute seul quand je clique sur un autre bouton de la même feuille.

Dim Rectangle_3 As Shape
If ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(2, 78, 170) Then
ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(47, 125, 79)
ElseIf ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(47, 125, 79) Then
ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(2, 78, 170)
End If

Vous pouvez m'aider?

Bien cordialement,

Bonjour,

Voici un essai avec les couleurs à adapter :

Sub MajColor()
sname = application.caller
for each sh in activesheet.shapes
    if sh.name = sname then sh.Fill.ForeColor.RGB = vbgreen else sh.Fill.ForeColor.RGB = vbred
next sh
end sub

Cette macro, en attendant une optimisation du code, doit être appelée par chaque macro liée à une forme. Ex :

sub macrorect1()
MajColor
'reste du code
end sub

Cdlt,

Bonjour,

Merci pour votre réponse. Le principe que je recherche marche parfaitement avec votre solution. Le bouton change de couleur quand je clique dessus et revient à la normale quand je clique sur un autre bouton.

Par contre, tout devient rouge tous les bouton, une zone texte et graphique, et la ça me convient moins:

Du coup voilà mon code: la première partie concerne mes calcules et la deuxième la gestion de la couleur des rectangles.

Est-ce que vous savez ce que je dois changer pour que le principe fonctionne correctement?

Application.ScreenUpdating = False
Range("K3").Select
ActiveCell.FormulaR1C1 = "=90%*RC[4]"
Range("K3").Select
Selection.AutoFill Destination:=Range("K3:K35")
Range("K3:K35").Select
Range("M3").Select
ActiveCell.FormulaR1C1 = "=10%*RC[2]"
Range("M3").Select
Selection.AutoFill Destination:=Range("M3:M35")
Range("M3:M35").Select
Application.ScreenUpdating = True

sname = Application.Caller
For Each sh In ActiveSheet.Shapes
If sh.Name = sname Then sh.Fill.ForeColor.RGB = vbGreen Else sh.Fill.ForeColor.RGB = vbRed
Next sh

Bonjour,

Bah, c'est très joli comme ça !

Pour éviter ça, il faut rajouter une condition :

Sub MajColor()
sname = application.caller
for each sh in activesheet.shapes
    if sh.name like "Rect*" then
        if sh.name = sname then sh.Fill.ForeColor.RGB = vbgreen else sh.Fill.ForeColor.RGB = vbred
    end if
next sh
end sub

Il faudra néanmoins renommer les rectangles dont la couleur doit demeurer : les noms ne doivent plus commencer par Rect

Seuls ceux dont la couleur alterne doivent commencer par Rect

Quant à la couleur, c'est à vous d'adapter : il faut remplacer vbgreen et vbred par les codes RGB de votre choix.

Et pour l'intégrer, essayez ce code :

Sub test()
MajColor
with activesheet
    .Range("K3:K35").FormulaR1C1 = "=90%*RC[4]"
    .Range("M3:M35").FormulaR1C1 = "=10%*RC[2]"
end with
end sub

Cdlt,

Re,

Voici un nouvel essai où on récupère les taux dans le texte de la forme cliquée :

Sub test()
TauxExt = GetTauxExt
TauxST = 1 - TauxExt
with activesheet
    .Range("K3:K35").FormulaR1C1 = "=" & TauxExt & "*RC[4]"
    .Range("M3:M35").FormulaR1C1 = "=" & TauxST & "*RC[2]"
end with
end sub

Function GetTauxExt() as double
sname = application.caller
for each sh in activesheet.shapes
    if sh.name like "Rect*" then
        if sh.name = sname then
            sh.Fill.ForeColor.RGB = vbgreen
            sTxt = sh.TextFrame2.TextRange.Characters.Text
            GetTauxExt = Convert(split(split(sTxt, vblf)(0), " : ")(1))
        else
            sh.Fill.ForeColor.RGB = vbred
        end if
    end if
next sh
end function

function Convert(Taux) as double
Convert = replace(Taux, "%", "") / 100
end function

Cdlt,

Encore merci pour tout votre aide, mais j'essaye vos solution depuis un moment et ça ne marche pas encore tout a fait.

Ce code la marche bien:

sname = Application.Caller
For Each sh In ActiveSheet.Shapes
If sh.Name = sname Then sh.Fill.ForeColor.RGB = vbGreen Else sh.Fill.ForeColor.RGB = vbRed
Next sh

Mais le problème c'est qu'il colorise tout en rouge une fois les formes non active. Hors je souhaite juste que ce soit mes rectangles qui soit concerné par le changement de couleur. Mon graphique et ma zone de texte ne doivent pas être impacté.

Exemple:

Couleur de base des boutons : Rouge

Je clique sur rectangle 3, il devient vert. Les autres bouton ne change pas de couleur et reste rouge.

Je clique sur rectangle 4, il devient vert et rectangle 3 redevient rouge.

Je clique sur rectangle 9, il devient vert et rectangle 4 redevient rouge.

Est-ce que vous pouvez m'expliquer avec des commentaires ce que font chaque ligne, pour que je comprenne comment cela marche s'il vous plaît?

Bien cordialement,

ça marche !!! :D

Voilà le code

sname = Application.Caller
For Each sh In ActiveSheet.Shapes
If sh.Name Like "Rect*" Then
If sh.Name = "Rectangle 3" Then sh.Fill.ForeColor.RGB = vbGreen Else sh.Fill.ForeColor.RGB = RGB(2, 78, 170)
End If
Next sh

Pour les futur intéréssé, "Rectangle 3" c'est le nom de l'un de mes rectangles.

MAIS,

Maintenant je vais avoir besoin d'un code similaire mais pour un cas plus délicat. Je reviens après déjeuner.

Adrien, relisez mes 2 précédents commentaires s'il vous plait pour suivre les consignes et prendre le dernier code posté.

La macro test est à affecter à chacune des formes.

Cdlt,