Bonjour,
je souhaiterai mettre en place ce fichier Excel en vba pour mon assoc, les données que je vous joins ne sont pas les vrais données
lorsque je clique mars et avril le fond de couleur change en bleu clair mais pas pour janvier et Février.
j'ai du faire une erreur mais je ne trouve pas laquelle
j'ai trouvé ce vba sur le net et je l'ai modifié avec mes données
merci pour votre aide
Option Explicit
' === Main helper: sets Selected_Month and recolors tabs ===
Private Sub SetMonthAndHighlight(ByVal monthName As String, ByVal clickedShapeName As String)
Dim ws As Worksheet
Dim tabs As Variant
Dim i As Long
Dim shp As Shape
' Performance toggles
Dim prevCalc As XlCalculation
prevCalc = Application.Calculation
On Error GoTo CleanUp
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws = ActiveSheet
' Update the selected month (named range)
ws.Range("Selection_Mois").Value = monthName
' The tabs we will recolor
tabs = Array("Tab_Janvier", "Tab_Fevrier", "Tab_Mars", "Tab_Avril")
' Reset all tabs to "not selected" color (#073673)
For i = LBound(tabs) To UBound(tabs)
Set shp = Nothing
On Error Resume Next
Set shp = ws.Shapes(CStr(tabs(i)))
On Error GoTo CleanUp
If Not shp Is Nothing Then
With shp.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(7, 54, 115) ' #073673
End With
End If
Next i
' Set clicked tab to "selected" color (#00B0F0)
Set shp = Nothing
On Error Resume Next
Set shp = ws.Shapes(clickedShapeName)
On Error GoTo CleanUp
If Not shp Is Nothing Then
With shp.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240) ' #00B0F0
End With
End If
CleanUp:
' Restore settings
Application.Calculation = prevCalc
Application.EnableEvents = True
Application.ScreenUpdating = True
' If you want the sheet to fully recalc after the change, uncomment:
' Application.Calculate
End Sub
' === Macros to assign to each shape ===
Sub Tab_Janvier()
SetMonthAndHighlight "Janvier", "Tab_Janvier"
End Sub
Sub Tab_Fevrier()
SetMonthAndHighlight "Fevrier", "Tab_Fevrier"
End Sub
Sub Tab_Mars()
SetMonthAndHighlight "Mars", "Tab_Mars"
End Sub
Sub Tab_Avril()
SetMonthAndHighlight "Avril", "Tab_Avril"
End Sub