Welcome toVigges Developer Community-Open, Learning,Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.9k views
in Technique[技术] by (71.8m points)

vba - Getting cell Interior Color Fails when range passed from Worksheet function

I am trying to get write a simple function one can call from a cell that would return if the background of a given cell has a specific background color.

This function works as expected when called from a sub-routine, but fails when called from the worksheet. At the line

IntColor = Cell.DisplayFormat.Interior.Color

Here is all of the code

Option Explicit

Public Function GetCellRGB(Rng As Range) As Integer()
    Dim Result(1 To 3) As Integer
    Dim Cell As Range
    Set Cell = Rng.Cells(1, 1)

    Dim IntColor As Integer

    ' when called from worksheet, function exits here with a #VALUE error
    IntColor = Cell.DisplayFormat.Interior.Color

    Result(1) = IntColor Mod 256 ' red
    Result(2) = IntColor  256 Mod 256 ' green
    Result(3) = IntColor  65536 Mod 256 ' blue

    GetCellRGB = Result
End Function

Public Function IsColor(Rng As Range, R As Integer, G As Integer, B As Integer) As Boolean
    Dim Vals() As Integer

    Vals = GetCellRGB(Rng)
    If R = Vals(1) And G = Vals(2) And B = Vals(3) Then
        IsColor = True
    Else
        IsColor = False
    End If
End Function

' This works as expected
Sub ColorTest()
    Dim Rng As Range
    Set Rng = ThisWorkbook.ActiveSheet.Range("A1")
    Debug.Print IsColor(Rng, 255, 0, 0)
End Sub

enter image description here

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Here's a workaround to the "DisplayFormat not available in a UDF" problem.

It uses Evaluate to side-step the UDF context

Public Function DFColor(addr)
    DFColor = Range(addr).DisplayFormat.Interior.Color
End Function

Function CFColorMatches(rng As Range, R As Long, G As Long, B As Long)
    CFColorMatches = (rng.Parent.Evaluate("DFColor(""" & rng.Address & """)") = RGB(R, G, B))
End Function

Note also you really don't need all that RGB-related code


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to Vigges Developer Community for programmer and developer-Open, Learning and Share
...