Arn*_*asM 2 excel vba excel-vba excel-2010
我有这个代码显示目标单元格的rgb颜色:
Function getRGB(RefCell)
Dim mystr As String
Application.Volatile
mystr = Right("000000" & Hex(RefCell.Interior.Color), 6)
getRGB = Application.Hex2Dec(Right(mystr, 2)) & ", " & _
Application.Hex2Dec(Mid(mystr, 3, 2)) & ", " & _
Application.Hex2Dec(Left(mystr, 2))
End Function
Run Code Online (Sandbox Code Playgroud)
我需要这个代码而不是炫耀其他单元格的rgb,会改变自己单元格的背景颜色.也许有人知道该怎么做?
在MSDN KB说
由工作表单元格中的公式调用的用户定义函数无法更改Microsoft Excel的环境.这意味着此类功能无法执行以下任何操作:在电子表格中插入,删除或格式化单元格.
不幸的是,这是不正确的!
您可以从调用公式的位置更改单元格的颜色.这是一个例子.这会将单元格的颜色更改Red为调用公式的位置.
诀窍是将空白值作为第一个参数传递给sub(a在下面的例子中).
它为什么有效?
我不知道!但它的工作原理:)
Function SetIt(RefCell)
RefCell.Parent.Evaluate "getRGB(" & """""" & "," & RefCell.Address(False, False) & ")"
SetIt = ""
End Function
Sub getRGB(a As String, RefCell As Range)
RefCell.Interior.ColorIndex = 3 '<~~ Change color to red
End Sub
Run Code Online (Sandbox Code Playgroud)
截图
EDIT(Credit Where Due):很久以前我曾经看过蒂姆·威廉姆斯的这个帖子,并且我已经尝试过它,并且我已经完成了很多其他知识,而KB文章说这是不可能的.
顺便说一句,我玩了更多,我能够让它工作,而不会传递空白字符串.
Function SetIt(RefCell)
RefCell.Parent.Evaluate "getRGB(" & RefCell.Address(False, False) & ")"
SetIt = ""
End Function
Sub getRGB(RefCell As Range)
RefCell.Interior.ColorIndex = 3
End Sub
Run Code Online (Sandbox Code Playgroud)
编辑
来自重复的问题和聊天(以下评论)
将其粘贴到代码模块中,然后在单元格中P20粘贴公式=setit(P20,N20)
Function SetIt(DestCell As Range, RefCell As Range)
RefCell.Parent.Evaluate "SetAndGetRGB(" & RefCell.Address(False, False) & _
"," & _
DestCell.Address(False, False) & ")"
SetIt = ""
End Function
Sub SetAndGetRGB(RefCell As Range, DestCell As Range)
Dim sRGB As String
Dim shName As String
shName = Split(RefCell.Value, "!")(0)
sRange = Split(RefCell.Value, "!")(1)
sRGB = Right("000000" & Hex(Sheets(shName).Range(sRange).Interior.Color), 6)
DestCell.Interior.Color = RGB( _
Application.Hex2Dec(Right(sRGB, 2)), _
Application.Hex2Dec(Mid(sRGB, 3, 2)), _
Application.Hex2Dec(Left(sRGB, 2)) _
)
End Sub
Run Code Online (Sandbox Code Playgroud)
注意:我没有做任何错误处理.我相信你可以照顾到这一点.