les macros

nono

XLDnaute Nouveau
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.
 

chris

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Re : les macros

Re

Sous réserve d'ajouter Oval 2 qui n'existe pas, ceci marche.
Code:
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...
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : les macros

Bonjour à tous.


Deux codes qui fonctionnent dans le classeur du message #16.​
Code:
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
Code:
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
 

Pièces jointes

  • Copie de couleuuur - Copy.xlsm
    33.7 KB · Affichages: 30

ROGER2327

XLDnaute Barbatruc
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 :​
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
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 726
Membres
110 552
dernier inscrit
jasson