Liste déroulante avec mise en forme conditionnelle [résolu]

'2 En projet : aucune mise en forme
'3 En attente : aucune mise en forme
'4 Validé:    police verte
'5 Refusé:    police grise + italique
'6 En cours de réalisation : police verte
'7 Travaux non conforme : police verte
'8 Terminé:    police rouge
'9 Facturé:    police bleu

Sub PseudoEventsDropDown(Optional dummy As Byte)
Dim DD As DropDown
Dim S As Worksheet
Dim R As Range
Set S = Sheets("JANVIER")
For Each DD In S.DropDowns
  If DD > 0 Then
    Set R = S.Range(S.Cells(DD.TopLeftCell.Row, 1), S.Cells(DD.TopLeftCell.Row, 7))
    With R.Font
      .Italic = False
      Select Case DD
       Case 4, 6, 7
        .Color = vbGreen
       Case 5
        .Color = RGB(125, 125, 125)
        .Italic = True
      Case 8
        .Color = vbRed
      Case 9
        .Color = vbBlue
      Case Else
        .ColorIndex = 0
      End Select
    End With
  End If
Next DD
End Sub

Private Sub Workbook_Activate()
Dim DD As DropDown
Dim S As Worksheet
Dim R As Range
Dim Lig&
Set S = Sheets("JANVIER")
Application.EnableEvents = False
For Each DD In S.DropDowns
  DD.ListFillRange = "VALEURS!$A$2:$A$21"
  Lig& = DD.TopLeftCell.Row
  DD.LinkedCell = "VALEURS!$M$" & Lig& & ""
  Sheets("VALEURS").Range("N" & Lig& & "").Formula = "=M" & Lig& & ""
Next DD
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If Sh.Name = "VALEURS" Then Call PseudoEventsDropDown
End Sub

'//////////////////////////////////////////
'/// Nécessite la librairie suivante    ///
'/// (faire menu Outils/Références...)  ///
'/// Library MSForms                    ///
'/// C:\WINDOWS\system32\FM20.DLL       ///
'/// Microsoft Forms 2.0 Object Library ///
'//////////////////////////////////////////

Sub CreeComboBox(Optional dummy As Byte)
Dim OL As OLEObject
Dim CB As ComboBox
Dim S As Worksheet
Dim R As Range
Dim var
Set R = ActiveCell
Set OL = ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
        DisplayAsIcon:=False, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)
Set CB = OL.Object
Set S = Sheets("VALEURS")
var = S.Range("a2:a" & S.[a3].End(xlDown).Row & "")
CB.List = var
CB.LinkedCell = R.Address
With CB.Font
  .Name = "Arial"
  .Size = 9
End With
Set OL = Nothing
Set CB = Nothing
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim S As Worksheet
Dim OL As OLEObject
Dim R As Range
Dim PLAGE As Range
Dim Mois
Dim var
Dim var2
Dim i&
Dim j&
Dim bool As Boolean
Mois = Array(, "2010", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
For i& = 1 To UBound(Mois)
  If Sh.Name = Mois(i&) Then
    bool = True
    Exit For
  End If
Next i&
If bool Then
  For Each OL In Sh.OLEObjects
    If OL.progID = "Forms.ComboBox.1" Then
      OL.Cut
      Set OL = Nothing
    End If
  Next OL
  If Sh.[a4] = "" Then Exit Sub
  Application.EnableEvents = False
  Set S = Sheets("VALEURS")
  var = S.Range("a2:c" & S.[a3].End(xlDown).Row & "")
  Set PLAGE = Sh.Range("a4:i" & Sh.[a3].End(xlDown).Row & "")
  var2 = PLAGE
  For i& = 1 To UBound(var2, 1)
    Set R = Sh.Range(Sh.Cells(i& + 3, 1), Sh.Cells(i& + 3, 9))
    With R.Font
      .Color = 0
      .Italic = False
    End With
    If var2(i&, 9) <> "" Then
      For j& = 1 To UBound(var, 1)
        If var2(i&, 9) = var(j&, 1) Then
          With R.Font
            .Color = var(j&, 3)
            If var2(i&, 9) = "Refusé" Then
              .Italic = True
            End If
          End With
          Exit For
        End If
      Next j&
    End If
  Next i&
  Application.EnableEvents = True
  '-----------
  If Target.Column = 9 Then
    If Not Application.Intersect(Target, PLAGE) Is Nothing Then
      Call CreeComboBox
    End If
  End If
End If
End Sub