[RESOLU] Shapes avec MFC personnalisées

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NumArr As String
Dim Vente As Integer

If Not Intersect(Target, Range("B2:B21")) Is Nothing Then
  Vente = Target.Value
  NumArr = "CP_" & Target.Offset(0, -1).Value
  
  Shapes(NumArr).Select
  With Selection
    .Font.FontStyle = "Gras"
  
  Select Case Vente
    Case 0 To 9
    .Font.ColorIndex = 2
    .ShapeRange.Fill.ForeColor.SchemeColor = 60
    .ShapeRange.Fill.BackColor.SchemeColor = 53
    .ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1

    Case 10 To 24
    .Font.ColorIndex = 53
    .ShapeRange.Fill.ForeColor.RGB = RGB(255, 192, 0)
    .ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 153)
    .ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1

    Case 25 To 100
    .Font.ColorIndex = 50
    .ShapeRange.Fill.ForeColor.RGB = RGB(195, 214, 155)
    .ShapeRange.Fill.BackColor.RGB = RGB(215, 228, 189)
    .ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1
    Case Else
    MsgBox "pas de couleur >100"
  End Select
  End With
End If

End Sub