Rimozione dei formati condizionali, ma non degli effetti (Microsoft Excel)

Option Explicit Sub PasteFC()

Application.ScreenUpdating = False     Dim rWhole As Range     Dim rCell As Range     Dim ndx As Integer     Dim FCFont As Font     Dim FCBorder As Border     Dim FCInt As Interior     Dim x As Integer     Dim iBorders(3) As Integer

iBorders(0) = xlLeft     iBorders(1) = xlRight     iBorders(2) = xlTop     iBorders(3) = xlBottom

Set rWhole = Selection

For Each rCell In rWhole         rCell.Select         ndx = ActiveCondition(rCell)

If ndx <> 0 Then             'Change the Font info             Set FCFont = rCell.FormatConditions(ndx).Font             With rCell.Font                 .Bold = NewFC(.Bold, FCFont.Bold)

.Italic = NewFC(.Italic, FCFont.Italic)

.Underline = NewFC(.Underline, FCFont.Underline)

.Strikethrough = NewFC(.Strikethrough, _                   FCFont.Strikethrough)

.ColorIndex = NewFC(.ColorIndex, FCFont.ColorIndex)

End With             'Change the Border Info for each of the 4 types             For x = 0 To 3                 Set FCBorder = rCell.FormatConditions(ndx).Borders(iBorders(x))

With rCell.Borders(iBorders(x))

.LineStyle = NewFC(.LineStyle, FCBorder.LineStyle)

.Weight = NewFC(.Weight, FCBorder.Weight)

.ColorIndex = NewFC(.ColorIndex, FCBorder.ColorIndex)

End With             Next x             'Change the interior info             Set FCInt = rCell.FormatConditions(ndx).Interior             With rCell.Interior                 .ColorIndex = NewFC(.ColorIndex, FCInt.ColorIndex)

.Pattern = NewFC(.Pattern, FCInt.Pattern)

End With             'Delete FC             rCell.FormatConditions.Delete         End If     Next     rWhole.Select     Application.ScreenUpdating = True     MsgBox ("The Formatting based on the Conditions" & vbCrLf & _       "in the range " & rWhole.Address & vbCrLf & _       "has been made standard for those cells" & vbCrLf & _       "and the Conditional Formatting has been removed")

End Sub

Function NewFC(vCurrent As Variant, vNew As Variant)

If IsNull(vNew) Then         NewFC = vCurrent     Else         NewFC = vNew     End If End Function

Function ActiveCondition(rng As Range) As Integer     'Chip Pearson http://www.cpearson.com/excel/CFColors.htm     Dim ndx As Long     Dim FC As FormatCondition

If rng.FormatConditions.Count = 0 Then         ActiveCondition = 0     Else     For ndx = 1 To rng.FormatConditions.Count         Set FC = rng.FormatConditions(ndx)

Select Case FC.Type             Case xlCellValue                 Select Case FC.Operator                     Case xlBetween                         If CDbl(rng.Value) >= CDbl(FC.Formula1) And _                           CDbl(rng.Value) <= CDbl(FC.Formula2) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlGreater                         If CDbl(rng.Value) > CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlEqual                         If CDbl(rng.Value) = CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlGreaterEqual                         If CDbl(rng.Value) >= CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlLess                         If CDbl(rng.Value) < CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlLessEqual                         If CDbl(rng.Value) <= CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlNotEqual                         If CDbl(rng.Value) <> CDbl(FC.Formula1) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case xlNotBetween                         If CDbl(rng.Value) <= CDbl(FC.Formula1) Or _                             CDbl(rng.Value) >= CDbl(FC.Formula2) Then                             ActiveCondition = ndx                             Exit Function                         End If                     Case Else                         Debug.Print "UNKNOWN OPERATOR"

End Select             Case xlExpression                 If Application.Evaluate(FC.Formula1) Then                     ActiveCondition = ndx                     Exit Function                 End If             Case Else                 Debug.Print "UNKNOWN TYPE"

End Select     Next ndx     End If     ActiveCondition = 0 End Function