Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FCible As Range, RCible As Range, Cible As Range, Plage As Range, T As Range, _
Tplage As Range, PlageFC As Range
Dim Adr As String
Dim N As Boolean, B As Boolean, P As Boolean, A As Boolean, VFC As Boolean
On Error Resume Next
Set PlageFC = Sh.Cells.SpecialCells(xlCellTypeAllFormatConditions)
If PlageFC Is Nothing Then Exit Sub
'Définition de la Plage cible
Set Plage = Target
Set Tplage = Plage.Dependents
Set Plage = Application.Union(Plage, Tplage)
On Error GoTo 0
Set Plage = Application.Intersect(Plage, PlageFC)
If Plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set Tplage = Nothing
For Each T In Plage
VFC = VerifFCond(T)
If VFC Then
If Tplage Is Nothing Then
Set Tplage = T
Else
Set Tplage = Union(Tplage, T)
End If
End If
Next T
'Traitement de la plage Cible
If Not Tplage Is Nothing Then
With ActiveWorkbook.Styles("Normal")
N = .IncludeNumber
B = .IncludeBorder
P = .IncludeProtection
A = .IncludeAlignment
.IncludeNumber = False
.IncludeBorder = False
.IncludeProtection = False
.IncludeAlignment = False
End With
For Each Cible In Tplage
Set FCible = FormatCible(Cible)
Set RCible = Nothing
On Error Resume Next
With Cible
Adr = Mid(.ID, 3)
Select Case Adr
Case "Cel"
Set RCible = Cible
Case "Lig"
Set RCible = Application.Intersect(.EntireRow, ActiveSheet.UsedRange)
Case Else
Adr = Replace(Adr, ";", ",")
If Val(Replace(Adr, "$", "")) > 0 Then
Set RCible = Application.Intersect(.EntireColumn, Range(Adr))
Else
Set RCible = Application.Intersect(.EntireRow, Range(Adr))
End If
End Select
End With
On Error GoTo 0
If Not RCible Is Nothing Then
With RCible
If FCible.Row = 65536 Then
'Format standard
.Style = "Normal"
Else
'Format MFC
With .Font
.Bold = FCible.Font.Bold
.Color = FCible.Font.Color
.Italic = FCible.Font.Italic
.Name = FCible.Font.Name
.Size = FCible.Font.Size
.Strikethrough = FCible.Font.Strikethrough
.Subscript = FCible.Font.Subscript
.Superscript = FCible.Font.Superscript
.Underline = FCible.Font.Underline
End With
With .Interior
.Color = FCible.Interior.Color
.Pattern = FCible.Interior.Pattern
.PatternColor = FCible.Interior.PatternColor
End With
End If
End With
End If
Next Cible
With ActiveWorkbook.Styles("Normal")
.IncludeNumber = N
.IncludeBorder = B
.IncludeProtection = P
.IncludeAlignment = A
End With
End If
Application.ScreenUpdating = True
End Sub
