Procedure trop longue...lol

Le 15/01/2014 à 13:34

bonjour,

y aurait il un moyen pour simplifier ma macro, car ca me dit procedure trop longue

Sub Bouton7_Cliquer()
 If Range("R6").Value < 6 Then
    ActiveSheet.Shapes("aa").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour41").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour81").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 1
    ElseIf Range("R6").Value = 6 Then
    ActiveSheet.Shapes("aa").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour41").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour81").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    ElseIf Range("R6").Value > 6 Then
    ActiveSheet.Shapes("aa").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour41").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour81").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour1").Fill.ForeColor.SchemeColor = 0
    End If
     Sheets("Feuil1").Select
    If Range("R7").Value < 6 Then
    ActiveSheet.Shapes("bb").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour42").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour82").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 1
    End If
    Sheets("Feuil1").Select
    If Range("R7").Value = 6 Then
    ActiveSheet.Shapes("bb").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour42").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour82").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    End If
    Sheets("Feuil1").Select
    If Range("R7").Value > 6 Then
    ActiveSheet.Shapes("bb").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour42").Fill.ForeColor.SchemeColor = 0
    ActiveSheet.Shapes("jour82").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour2").Fill.ForeColor.SchemeColor = 0
    End If
    Sheets("Feuil1").Select
    If Range("R8").Value < 6 Then
    ActiveSheet.Shapes("cc").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil2").Select
    ActiveSheet.Shapes("jour3").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour43").Fill.ForeColor.SchemeColor = 1
    ActiveSheet.Shapes("jour83").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil4").Select
    ActiveSheet.Shapes("jour3").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil7").Select
    ActiveSheet.Shapes("jour3").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil9").Select
    ActiveSheet.Shapes("jour3").Fill.ForeColor.SchemeColor = 1
    Sheets("Feuil11").Select
    ActiveSheet.Shapes("jour3").Fill.ForeColor.SchemeColor = 1
    End If

parce que mon problem c'est que j'arrive jusqu'au "jour24" de mes images mais j'en ai 31 par feuille...

Le 15/01/2014 à 14:02
Sub toto()
    Dim i As Integer
    x = Array("aa", "bb", "cc")
    For i = 6 To 8
        If Sheets("Feuil1").Range("R" & i) < 6 Then
            Sheets("Feuil1").Shapes(x(i - 6)).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil2").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil2").Shapes("jour" & i + 35).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil2").Shapes("jour" & i + 75).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil4").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil7").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil9").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 1
            Sheets("Feuil11").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 1
        Else
            Sheets("Feuil1").Shapes(x(i - 6)).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil2").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil2").Shapes("jour" & i + 35).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil2").Shapes("jour" & i + 75).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil4").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil7").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil9").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 0
            Sheets("Feuil11").Shapes("jour" & i - 5).Fill.ForeColor.SchemeColor = 0
        End If
    Next i
End Sub

Si tu veux accélerer le code, il te suffira de faire un application.screenupdating = False en début de code et le repasser à true en fin de code

Le 15/01/2014 à 14:42

merci ca marche du coup comment je fais pour rajouter toutes mes images?? j'en ai 31 sur les feuilles1, 4; 7, 9 et 11 et 93 sur la feuille 2... qui se noircissent selon la valeur en "R6"(qui correspond aux images "aa" et "jour1" de toutes les feuilles) jusqu'a "R36" ("af" et "jour31")

Le 16/01/2014 à 07:16

voici la totalite de mon code que j'ai du faire en 2 macros, si vous connaissez un moyen pour le simplifier...

20code.zip (2.21 Ko)
Le 20/01/2014 à 10:15

quelqu'un pourrait m'aider svp??

Le 20/01/2014 à 11:24

Bonjour,

il faudrait le fichier excel avec les shapes pour que cela soit plus parlant. Je peux voir si je oeux quelque chose.

Merci

Mon avis serait de regrouper tous les cas pour lesquels tu as Fill.ForeColor.SchemeColor = 1

tous les cas pour lesquels tu as Fill.ForeColor.SchemeColor = 0

Tu peux ensuite faire un select case: case <6, case else.

On peux aussi simplifier avec le parametre array. Faut voir le fichier de données pour se faire une idée.

Le 20/01/2014 à 13:17

Tu vois ma macro ? Tu changes ces deux lignes

    x = Array("aa", "bb", "cc")
    For i = 6 To 8

Et c'est bon

Rechercher des sujets similaires à "procedure trop longue lol"