vba - 从工作表函数传递范围时获取单元格内部颜色失败
问题描述
我正在尝试编写一个可以从单元格调用的简单函数,如果给定单元格的背景具有特定的背景颜色,该函数将返回。
从子例程调用时,此函数按预期工作,但从工作表调用时失败。在线上
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
解决方案
这是“DisplayFormat 在 UDF 中不可用”问题的解决方法。
它用于Evaluate
回避 UDF 上下文
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 相关的代码
推荐阅读
- r - R光栅对象上的自动阈值
- php - 如何使 apply_filter 仅适用于 WooCommerce 中的特定产品?
- python - Python 3 打印样式
- swift - Swift 存储所有随机生成且不会再次生成的数字
- javascript - 使用 xhr 发送帖子请求
- java - 将 docker 镜像部署到 kubernetes 的问题
- php - MySQLi 查询不执行
- c# - Outlook 插件 - 新约会事件处理程序
- python - Python/Dash by Plotly:如何编写一个包含参数的 csv 来对正在写入的数据集的列中的所有日期进行排序?
- java - 将数学公式输入java