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,