macro mise a jour

[al1000]

bonjour,

Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$6" Then
Select Case Target.Value
Case 1
ActiveSheet.Shapes("c vert").ZOrder msoBringToFront
Case 2
ActiveSheet.Shapes("c jaune").ZOrder msoBringToFront
Case 3
ActiveSheet.Shapes("c rouge").ZOrder msoBringToFront
End Select
End If
If Target.Address = "$H$32" Then
Select Case Target.Value
Case 1
ActiveSheet.Shapes("p vert").ZOrder msoBringToFront
Case 2
ActiveSheet.Shapes("p jaune").ZOrder msoBringToFront
Case 3
ActiveSheet.Shapes("p rouge").ZOrder msoBringToFront
End Select
End If
If Target.Address = "$D$50" Then
Select Case Target.Value
Case 1
ActiveSheet.Shapes("s vert").ZOrder msoBringToFront
Case 2
ActiveSheet.Shapes("s rouge").ZOrder msoBringToFront
End Select
End If
VformesD = [J6] * 100 + [H32] * 10 + [D50]
If VformesD < 123 Then
ActiveSheet.Shapes("pe vert").ZOrder msoBringToFront
Else
If VformesD = 111 Or VformesD = 333 Then
ActiveSheet.Shapes("pe jaune").ZOrder msoBringToFront
Else
If VformesD > 333 Then
ActiveSheet.Shapes("pe rouge").ZOrder msoBringToFront
End If
End If
End Sub

je n'arrive pas a la faire fonctionner

pourquoi

a+

 

[edelweisseric]

Re : macro mise a jour

Bonsoir à tous

Dis donc al1000, ne serait ce pas la suite de la demande sur "perf.xls" ????? : https://www.excel-downloads.com/threads/macro.68742/

Je ne pensais pas que tu ne l'avais pas eu (la réponse), ou peut être pas comprise (!)

Si c'est le cas, reprends ma réponse et dis nous, sur ce post, ce qui ne va pas, et nous pourrons t'aider, sinon dépose un fichier.



A+

 

[al1000]

Re : macro mise a jour

bonjour,

Que veux dire ce code derriere la feuille:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Sub


Pourquoi en a28 on coit mettre 1 2 ou 3?

Poirquoi ce code?

On Error Resume Next
Dim objet As Shape
For Each objet In ActiveSheet.Shapes
If Left(objet.Name, 10) = "jaune1" Then objet.Delete
If Left(objet.Name, 10) = "rouge1" Then objet.Delete
If Left(objet.Name, 10) = "bleu1" Then objet.Delete
Next objet

a+

 

[Eric 45]

Re : macro mise a jour

Bonjour à tous
Bonjour al1000

Quelques explications :

****
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Sub
****
Dès que tu changes de cellule sur cette feuille, ce code est lu, cad que si tu cliques sur "a2" et que tu veux qu'un événement se produise tu l'écris dans cette procédure. Dans ce cas ci il n'a pas lieu d'être désolé = donc à supprimer

****
On Error Resume Next
Dim objet As Shape
For Each objet In ActiveSheet.Shapes
If Left(objet.Name, 10) = "jaune1" Then objet.Delete
If Left(objet.Name, 10) = "rouge1" Then objet.Delete
If Left(objet.Name, 10) = "bleu1" Then objet.Delete
Next objet
****
Ce code correspond à l’effacement des cercles

****
« a28 » c’est la cellule de test, pour toi ce sera j6,…… et ta valeur

****

C’est juste pour vérifier que le rond jaune, bleu,.. se « dessine

A+

 

[al1000]

Re : macro mise a jour

Bonjour,

If Target.Address = "$J$6" Then
Select Case Target.Value
Case 1
ActiveSheet.Shapes("c vert").ZOrder msoBringToFront
Case 2
ActiveSheet.Shapes("c jaune").ZOrder msoBringToFront
Case 3
ActiveSheet.Shapes("c rouge").ZOrder msoBringToFront


si j'ai bien compris dans ce code:
la valeur de la case peut etre 1;2 ou 3

alors que dans mon cas j6 peut etre compris entre 0 et 200

If Target.Address = "$J$6" Then
Select Case Target.Value
de 0 à 90
ActiveSheet.Shapes("c vert").ZOrder msoBringToFront
90 à 100
ActiveSheet.Shapes("c jaune").ZOrder msoBringToFront
superieur à 100
ActiveSheet.Shapes("c rouge").ZOrder msoBringToFront

comment ecrire cete macro si j6 peut avoir des valeurs de 0 à 200


a+

 

[Eric 45]

Re : macro mise a jour

Bonjour à tous

Une réponse à ta question

Select Case Target.Value
case is >100
ActiveSheet.Shapes("c rouge").ZOrder msoBringToFront
case is >90
ActiveSheet.Shapes("c jaune").ZOrder msoBringToFront
Case Else
ActiveSheet.Shapes("c vert").ZOrder msoBringToFront


A+