Sub
setFC()
Dim
ws
As
Worksheet, strWs$
Set
ws = ActiveSheet
Call
deletefc(ws.Name)
With
ws.Range(
"A1:B10"
)
.FormatConditions.Add Type:=xlExpression, Formula1:=
"=UND(F3<>"
""
";F3="
"FS/BE"
";ODER(F6="
"MI/BE"
"; F9="
"MI/BE"
"; F12="
"MI/BE"
";F15="
"MI/BE"
";F18="
"MI/BE"
"))"
With
.FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With
.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End
With
.StopIfTrue =
False
End
With
End
With
End
Sub
Function
deletefc(wsName
As
String
)
Dim
i
As
Long
, objfc
As
FormatCondition
Application.ScreenUpdating =
False
Application.Calculation = xlManual
Application.EnableEvents =
False
With
Worksheets(wsName).Cells
For
i = .FormatConditions.Count
To
1
Step
-1
On
Error
Resume
Next
Set
objfc = .FormatConditions(i)
objfc.Delete
On
Error
GoTo
0
Next
End
With
Application.EnableEvents =
True
Application.Calculation = xlAutomatic
Application.ScreenUpdating =
True
End
Function