les macros

[nono]

bonjour,
j ai quelques petits soucis avec les macros
je pense en avoir cree une bien mais elle ne fonctionne pas.
quelqu un peut il me dire l erreure ?

Le but de cette macro est de metre des couleurs a des ovales suivant le resultat de cellules.
regarde :

Sub Macro()
If [L:L] <= 1 Then
ActivateSheet.Shapes("Oval1").Fill.ForeColor.SchemeColor = 4
ActivateSheet.Shapes("Oval1").Fill.Visible = msoTrue
Else
ActivateSheet.Shapes("Oval1").Fill.Visible = msoFalse
End If
If [L:L] >= 3 <=17 Then
ActivateSheet.Shapes("Oval1").Fill.ForeColor.SchemeColor = 41
ActivateSheet.Shapes("Oval1").Fill.Visible = msoTrue
Else
ActivateSheet.Shapes("Oval1").Fill.Visible = msoFalse
End If
If [L:L] >= 25 <= 50 Then
ActivateSheet.Shapes("Oval1").Fill.ForeColor.SchemeColor = 27
ActivateSheet.Shapes("Oval1").Fill.Visible = msoTrue
Else
ActivateSheet.Shapes("Oval1").Fill.Visible = msoFalse
End If
If [L:L] >= 51 <= 80 Then
ActivateSheet.Shapes("Oval1").Fill.ForeColor.SchemeColor = 46
ActivateSheet.Shapes("Oval1").Fill.Visible = msoTrue
Else
ActivateSheet.Shapes("Oval1").Fill.Visible = msoFalse
End If
If [L:L] >= 81 Then
ActivateSheet.Shapes("Oval1").Fill.ForeColor.SchemeColor = 3
ActivateSheet.Shapes("Oval1").Fille.Visible = msoTrue
End If
End Sub

Merci a celui ou celles qui me repondra.

Arnaud.

 

[nono]

Re : les macros

vous trouverez mon fichier en piece jointe
merci pour l aide et le temps.

 

[chris]

Re : les macros

Re

Il n'y a rien en cellule L2 et tes "Oval" ont une appelation de type Oval 1 et non Oval1...

Il serait bien, outre le fichier d'expliquer concrètement ce que tu cherches à faire puisqu'il y a plus de 30 "Oval"

 

[nono]

Re : les macros

dsl si je n ai pas ete clair... je vais essayer d etre plus comprehensible :
par exemple j aimerais que :
- mon oval 1 corresponde a ma cellule j2 (pour que l ovql deviennent orange et si la cellule change de couleur ;on oval devra faire de meme)
- mon oval 2 doit correspondre a ma cellule j3 .....
ect......
merci

 

[chris]

Re : les macros

Re

Sous réserve d'ajouter Oval 2 qui n'existe pas, ceci marche.

Sub Color_oval()
Dim cellule As Range

For Each cellule In ActiveSheet.Range("J2:J" & ActiveSheet.Range("J" & Cells.Rows.Count).End(xlUp).Row)
    ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.Visible = msoFalse
    Select Case cellule.Value
         Case Is <= 1
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.ForeColor.SchemeColor = 4
            ActiveSheet.Shapes("Oval ").Fill.Visible = msoTrue
        Case 3 To 17
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.ForeColor.SchemeColor = 41
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.Visible = msoTrue
        Case 25 To 50
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.ForeColor.SchemeColor = 27
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.Visible = msoTrue
        Case 51 To 80
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.ForeColor.SchemeColor = 46
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.Visible = msoTrue
        Case Is >= 81
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.ForeColor.SchemeColor = 3
            ActiveSheet.Shapes("Oval " & cellule.Row - 1).Fill.Visible = msoTrue
        End Select
    Next
End Sub

Cependant je ne sais si les trous entre 1 et 3, 17 et 25, etc sont voulus....

Edit : il semblerait que Roger, que je salue , n'ait pas eu de souci avec Oval 2...

 

[ROGER2327]

Re : les macros

Bonjour à tous.

Deux codes qui fonctionnent dans le classeur du message #16.​

Sub Color_oval_a() 'ROGER2327
Dim i&, a%
    With ActiveSheet
        For i = 1 To 45
            Select Case .[J1].Offset(i).Value
            Case Is <= 1: a = 4
            Case 3 To 17: a = 41
            Case 25 To 50: a = 27
            Case 51 To 80: a = 46
            Case Is >= 81: a = 3
            Case Else: a = 0
            End Select
            With .Shapes(i).Fill
                .ForeColor.SchemeColor = a
                .Visible = (a <> 0)
            End With
        Next
    End With
End Sub

Sub Color_oval_b() 'ROGER2327
Dim i&, x
    With ActiveSheet
        For i = 1 To 45
            x = .[J1].Offset(i).Value
            With .Shapes(i).Fill
                .ForeColor.SchemeColor = -4 * (x <= 1) + 41 * (3 <= x) * (x <= 17) + 27 * (25 <= x) * (x <= 50) + 46 * (51 <= x) * (x <= 80) - 3 * (81 <= x)
                .Visible = (.ForeColor.SchemeColor <> 0)
            End With
        Next
    End With
End Sub

Bonne fête.


ℝOGER2327
#7958

Dimanche 1[SUP]er[/SUP] Tatane 142 (Fête du Père Ubu (Ubu d’été) - fête Suprême Première seconde)
26 Messidor An CCXXIII, 0,8582h - sauge
2015-W29-2T02:03:35Z

 

[nono]

Re : les macros

c est super les pro, les couleurs sont bien la et ca commece a prendre forme
cependant l oval 1 ne correspond pas a ma cellule j2
l oval 2 a ma cellule j3 ect.... comment puis je faire ?
merci les experts

 

[chris]

Re : les macros

Bonjour

Dans mon cas, j'ai ajouté Oval 2 qui n'existait pas et bien suivi Oval 1 = J2 et la suite...

Pour Roger, en l'absence d'Oval 2, il y a sans doute un décalage...

 

[ROGER2327]

Re : les macros

Re...

(...)
cependant l oval 1 ne correspond pas a ma cellule j2
l oval 2 a ma cellule j3 ect....
(...)

(...)
Pour Roger, en l'absence d'Oval 2, il y a sans doute un décalage...

Dans mon code, les contrôles sont traitées séquentiellement dans l'ordre de leur création, sans référence à leurs noms.
Dans le classeur du message #20, les contrôles sont, dans l'ordre de création, "Oval 1", "Oval 3", "Oval 4", "Oval 5", etc. jusqu'à "Oval 46". Ensuite, "Button 1", "Button 2".
Par conséquent, "Oval 1" est associé à J2, "Oval 3" est associé à J3, etc. jusqu'à, "Oval 46", associé à J46.

Pour voir comment sont hiérarchisés les contrôles de la feuille active, exécutez ce code :​

Sub tata()
Dim i%, x$
    x$ = "Formes de la feuille active" & vbLf & vbLf & "Item" & vbTab & "Nom"
    With ActiveSheet
        For i = 1 To .Shapes.Count
            x$ = x$ & vbLf & i & vbTab & .Shapes(i).Name
        Next
    End With
    MsgBox x
End Sub

En cas d'ajout de contrôles, vous pouvez réorganiser la hiérarchie en utilisant la méthode ZOrder : vous trouverez tout ce qu'il faut à l'article Shape.ZOrder de l'aide fournie avec Excel.​

Bonne soirée.


ℝOGER2327
#7959

Dimanche 1[SUP]er[/SUP] Tatane 142 (Fête du Père Ubu (Ubu d’été) - fête Suprême Première seconde)
26 Messidor An CCXXIII, 7,2383h - sauge
2015-W29-2T17:22:19Z