Couleur de bouton suivant date

Bonjour à tous amis du forum,

J’ai monté un petit fichier pour le club de basket de mon garçon et pour suivre le planning des matchs de la saison j'ai mis en place des boutons pour effectuer un tri dans le calendrier.

Je désirerai que la couleur des boutons des mois de la saison change de couleur automatiquement au changement de mois.

Le fichier joint n'est que la page de garde avec les boutons qui m'intéressent, histoire de faire léger.

En vous remerciant

Didier

28usob-essai.xlsm (88.89 Ko)

re bonjour, j'ai pensé a ce genre de code mais je n'arrive pas à ce qu'il fonctionne de façon automatique et autonome

Private Sub clic()
    If Range("A4").Value = 9 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 1")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 9 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 1")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 10 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 2")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 10 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 2")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 11 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 3")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 11 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 3")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 12 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 4")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 12 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 4")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 1 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 5")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 1 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 5")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 2 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 6")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 2 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 6")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 3 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 7")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 3 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 7")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 4 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 8")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 4 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 8")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 5 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 9")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 5 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 9")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 6 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 10")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 6 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 10")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If

    If Range("A4").Value = 7 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 11")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset31
    End If
        If Range("A4").Value <> 7 Then
        ActiveSheet.Shapes.Range(Array("Pentagon 11")).Select
        Selection.ShapeRange.ShapeStyle = msoShapeStylePreset39
    End If
End Sub

merci

10usob-essai.xlsm (19.85 Ko)

Did350, le forum,

Ceci devrait fonctionner ...

La macro ne s'exécutera qu'à l'ouverture du fichier.

Dans "Thisworkbook" ajoute :

Private Sub Workbook_Open()
    Module1.ChangeLeMois
End Sub

Dans "Module1" ajoute :

Sub ChangeLeMois()

With Worksheets("Choix")

    If Month(Now) = 9 Then
        .Shapes.Range("Pentagon 1").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 1").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 10 Then
        .Shapes.Range("Pentagon 2").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 2").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 11 Then
        .Shapes.Range("Pentagon 3").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 3").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 12 Then
        .Shapes.Range("Pentagon 4").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 4").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 1 Then
        .Shapes.Range("Pentagon 5").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 5").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 2 Then
        .Shapes.Range("Pentagon 6").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 6").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 3 Then
        .Shapes.Range("Pentagon 7").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 7").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 4 Then
        .Shapes.Range("Pentagon 8").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 8").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 5 Then
        .Shapes.Range("Pentagon 9").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 9").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 6 Then
        .Shapes.Range("Pentagon 10").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 10").ShapeStyle = msoShapeStylePreset39
    End If

    If Month(Now) = 7 Then
        .Shapes.Range("Pentagon 11").ShapeStyle = msoShapeStylePreset31
    Else
        .Shapes.Range("Pentagon 11").ShapeStyle = msoShapeStylePreset39
    End If

End With
End Sub

LaCéline

merci beaucoup Céline, je testerai cela dés demain et je te tiens au courant

Didier

Bonsoir,

Modifier les noms des Shapes en Mois09 à Mois07...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim m%, i%
    If Target.Address = "$A$4" Then
        m = Target.Value
        Application.ScreenUpdating = False
        For i = 1 To 12
            Select Case i
                Case 8
                Case m
                    Me.Shapes("Mois" & Format(m, "00")).ShapeStyle = msoShapeStylePreset38
                Case Else
                    Me.Shapes("Mois" & Format(i, "00")).ShapeStyle = msoShapeStylePreset32
            End Select
        Next i
    End If
End Sub

Cordialement.

Merci Beaucoup à Melle Céline et à Mferrand pour votre aide, cela fonctionne impeccablement bien.

une bonne continuation et à bientot

Didier

Rechercher des sujets similaires à "couleur bouton suivant date"