Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Value <> "" Then
ActualiserFormuleMFC Target
End If
End If
End Sub
Sub ActualiserFormuleMFC(pCellule As Range)
Dim i As Integer
Dim WS As Worksheet
Dim MFC As FormatConditions
Dim PlageApplication As String
'Boucle sur toutes les feuille de calcul du classeur
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Paramètre" Then
' pour éviter d'avoir une MFC scindée en 2 :
' - 1ère boucle sur la plage intersection avec la cellule modèle
' - on récupère la plage d'application (contrainte : on considère qu'elle est unique !)
' - 2ème boucle avec plage d'application
Set MFC = WS.Range(pCellule.Address).FormatConditions
PlageApplication = ""
' 1ère boucle sur la plage intersection avec la cellule modèle
For i = 1 To MFC.Count
With MFC(i)
If (.Type = xlExpression) And _
(Not (Intersect(WS.Range(.AppliesTo.Address), WS.Range(pCellule.Address)) Is Nothing)) Then
' on récupère la plage d'application (contrainte : on considère qu'elle est unique !)
PlageApplication = .AppliesTo.Address
Exit For
End If
End With
Next i
If PlageApplication <> "" Then
' 2ème boucle avec plage d'application
Set MFC = WS.Range(PlageApplication).FormatConditions
For i = 1 To MFC.Count
With MFC(i)
If (.Type = xlExpression) Then
.Modify Type:=.Type, Formula1:=CStr(pCellule.Value)
End If
End With
Next i
End If
End If
Next WS
Set MFC = Nothing
Set WS = Nothing
End Sub