VBA function 测试单元格是否在 Excel 中有条件地格式化

Question

I have written the function below to test if a cell has conditional formatting activated based upon the cell fill.

Function cfTest(inputCell)

    If inputCell.DisplayFormat.Interior.Color <> 16777215 Then
        cfTest = True
    Else
       cfTest = False
    End If
End Function

It does not work however. Saying that, this method does.

Sub myCFtest()
Dim R As Integer
R = 2
Do
    If Range("I" & R).DisplayFormat.Interior.Color <> 16777215 Then
        Range("K" & R).Value = True
    Else
        Range("K" & R).Value = False
    End If

    R = R + 1

Loop Until R = 20
End Sub

Can anyone explain to me why the function will not work?

Cheers.

EDIT : Updated function but not working for conditional formatting

Function cfTest(inputCell)
    If inputCell.Interior.ColorIndex <> -4142 Then
        cfTest = True
    Else
       cfTest = False
    End If
End Function

Answer 1

Here is a working demo if the desired result. Column E looks at column D and displays the value TRUE if it is conditionally formatted by cell fill color. ie click on the name 'Bob', and conditionally formatting highlights the cell via the code below

=IF(AND(CELL("row")=ROW(D1),CELL("col")=COLUMN(D1)),TRUE)

Click on another name, and the same result occurs.

However, when I click off the names onto another cell, I last name selected remains highlighted, giving the impression of a button still depressed.

The VBA code behind is as follows.

This sits within the Sheet1 code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 4 And Target.Row <= Application.WorksheetFunction.CountA(Range("D:D")) Then
    Range("D:D").Calculate
    Call cfTest

End If

End Sub

And this is the method itself:

Sub cfTest()

Range("E:E").ClearContents

If ActiveCell.DisplayFormat.Interior.color <> 16777215 Then
    ActiveCell.Offset(0, 1) = True
End If

End Sub

The application I ended up building off this example had much more too it, but going back to the posted question, the cfTest() method allowed me to test if a cell was conditionally formatted based upon cell fill.

Answer 2

I'm not sure as to the why of this but maybe it'll help. VB doesn't seem to allow access to a cells color when that color is based on conditional formatting.

For example..

'cell A1 colored yellow through conditional formatting
MsgBox Range("A1").Interior.ColorIndex
'returns the incorrect result of -4142 regardless of cell color

'cell B1 colored yellow via the fill option on the ribbon
MsgBox Range("B1").Interior.ColorIndex
'returns the correct result of 6

That being said, is there a reason you couldn't just test the cell for whatever formatting rules you have in effect. That would eliminate the need for a UDF.

=IF(A1<50,False,True)

Answer 3

Here are two related functions that implement mathematical conditions. This is slightly less complicated than the Chip Pearson version, and also less complete, but I think this should cover most cases, and this shouldn't be too difficult to extend.

Function isConditionallyFormatted(rng As Range) As Boolean

    Dim f As FormatCondition

    On Error Resume Next
    isConditionallyFormatted = False
    For Each f In rng.FormatConditions

        isConditionallyFormatted = checkFormula(rng.Value, f.operator, f.Formula1)
        isConditionallyFormatted = checkFormula(rng.Value, f.operator, f.Formula2)

        Next

End Function

Function checkFormula(rng As Variant, operator As Variant, condition As Variant)

    On Error GoTo errHandler:

    Dim formula As String
    condition = Right(condition, Len(condition) - 1)
    Select Case operator

            Case xlEqual: formula = rng & "=" & condition
            Case xlGreater: formula = rng & ">" & condition
            Case xlGreaterEqual: formula = rng & ">=" & condition
            Case xlLess: formula = rng & "<" & condition
            Case xlLessEqual: formula = rng & "<=" & condition
            Case xlExpression: formula = condition

            End Select

    checkFormula = Evaluate(formula)
Exit Function
errHandler:
    Debug.Print Err.Number & " : " & Err.Description
End Function

This will work for some common operators, but there are two other operators (xlBetween and xlNotBetween) and there are other types of condition that would have to be caught as well, and the logic for some of those would be a little more complicated than this. Some of them, however (like databars), inherently convey that there is a condition, so no processing would be necessary.

Here is a link to the full documentation:

http://msdn.microsoft.com/en-us/ff835850(v=office.15)

Answer 4

I would perform a prior check for the color index your condition is for using this:

Function cfTest_color_chk(inputCell As Range)
  cfTest_color_chk = inputCell.Interior.ColorIndex
End Function

Then your function

Function cfTest(inputCell As Range)
  If inputCell.Interior.ColorIndex <> -4142 Then
      cfTest = True
  Else
     cfTest = False
  End If
End Function

Another solution to make things rock solid is to combine both function so that cfTest takes cfTest_color_chk as a parameter and cfTest_color_chk will return the value of the color to match...

Hope this helps

Pascal

Answer 5

Here is UDF that allows to check if a FormatCondition is True/False for one of the cells it applies to. It is intended only to FormatConditions with an Operator property of xlExpression , to complete Chip Pearson version, which only tests the "fixed" Formula1 of a FormatCondition on the first cell in its AppliesTo Range .

Function CheckFC(fc As FormatCondition, rng As Range) As Variant 'fc must must be a member of rng.FormatConditions, and rng must be in fc.AppliesTo Range
'Function CheckFC(fc As FormatCondition) As Variant 'also possible, fc.Parent(1) will be the first cell in the range from which was extracted the FormatCondition
    Set c = rng(1)
    If Intersect(c, fc.AppliesTo) Is Nothing Then Exit Function
    If Application.LanguageSettings.LanguageID(MsoAppLanguageID.msoLanguageIDUI) <> 1033 Then
        'Français; France; fr-FR; 1036
        Set temp = Cells(Selection.Parent.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, "A")
        temp.FormulaLocal = fc.Formula1
        strFormulaMoved$ = Application.ConvertFormula( _
                                                        Application.ConvertFormula(temp.Formula, XlReferenceStyle.xlA1, XlReferenceStyle.xlR1C1, , fc.AppliesTo(1)), _
                                                        XlReferenceStyle.xlR1C1, XlReferenceStyle.xlA1, , c)
        temp.ClearContents
    Else
        'English; United States; fr-FR; 1033
        
        strFormulaMoved$ = Application.ConvertFormula( _
                                                        Application.ConvertFormula(fc.Formula1, XlReferenceStyle.xlA1, XlReferenceStyle.xlR1C1, , fc.AppliesTo(1)), _
                                                        XlReferenceStyle.xlR1C1, XlReferenceStyle.xlA1, , c)
    End If
        CheckFC = Application.Evaluate(strFormulaMoved)
End Function

Example:

?CheckFC(Selection.FormatConditions(1), Selection)