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