代码之家 › 专栏 › 技术社区 › Vince W.

从工作表函数传递范围时获取单元格内部颜色失败

excel-vba vba excel

Vince W. · 技术社区 · 6 年前

我试图得到一个简单的函数,可以从一个单元格调用,如果一个给定的单元格的背景有一个特定的背景颜色将返回。

当从子程序调用时,此函数按预期工作,但从工作表调用时失败。在那条线上

IntColor = Cell.DisplayFormat.Interior.Color

这里是所有的代码

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

2 回复 | 直到 6 年前

Tim Williams 6 年前

这里有一个解决“DisplayFormat在UDF中不可用”问题的方法。

它使用 Evaluate 绕过自定义项上下文

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

请注意,你真的不需要所有的RGB相关的代码

Ibo 6 年前

RGB是由VBA本身计算的,您不需要假定它是一个数组,它实际上是一个长整数,因此如果您想检查单元格的背景色,您只需简单地执行此操作即可,这也适用于工作表:

Public Function IsColor(Rng As Range, R As Integer, G As Integer, B As Integer) As Boolean
    If Rng.Interior.Color = RGB(R, G, B) Then
        IsColor = True
    Else
        IsColor = False
    End If
End Function

推荐文章