Option Explicit
'---------------------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!)
' Date : 18/09/2005
' Sujet : MFC multiples
'---------------------------------------------------------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim TabTemp As Variant
Dim L As Long
Dim V As Variant
'Ne gère pas les sélections de plages
If Target.Cells.Count > 1 Then Exit Sub
'Vérifie la présence du format conditionnel 'spécial'
If Target.FormatConditions.Count < 1 Then Exit Sub
If Target.FormatConditions(1).Formula1 = '=mDF' Then
With Sheets('MFC')
'Charge les préférences dans un tableau variant temporaire
L = .Range('A65536').End(xlUp).Row
TabTemp = .Range(.Cells(1, 1), .Cells(L, 1)).Value
'Détermine le format à utiliser suivant la valeur de la cellule
If Target.Value = '' Then
L = 1
Else
For L = 2 To UBound(TabTemp, 1)
'Fonctionne en minuscule/majuscule pour les chaines de caractères
If UCase(Target.Value) = UCase(TabTemp(L, 1)) Then Exit For
Next L
End If
'Gestion des erreurs (impératif, compte tenu de la désactivation des évènements)
On Error GoTo Fin
Application.EnableEvents = False
'Applique le format (sauf les bordures)
.Cells(L, 2).Copy
V = Target.Formula
Target.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Target.Formula = V
'Il semble que sur Mac et dans certaines situations (non ciblées) le format
'conditionnel 'spécial' d'origine ne soit pas écrasé par le nouveau, il convient
'donc de s'en assurer avant de réimposer ce format spécial.
If Target.FormatConditions.Count < 1 Then Target.FormatConditions.Add Type:=xlExpression, Formula1:='=mDF'
Application.CutCopyMode = False
Application.EnableEvents = True
End With
End If
Exit Sub
Fin:
'En cas d'erreur dans le code, il convient impérativement de rétablir la gestion des
'évènements d'application pour la suite. Par une gestion d'erreur, on réaffecte la
'valeur True à la propriété Application.EnableEvents et on informe l'utilisateur qu'une
'erreur non gérée est survenue
MsgBox 'Erreur non gérée dans la procédure Workbook.SheetChange()' & vbLf & 'Erreur : ' & _
Err & ' ' & Err.Description, vbOKOnly, 'myDearFriend!'
Application.EnableEvents = True
End Sub