I have this code which shows rgb color of target cell:
我有这个代码显示目标单元格的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
I need that this code instead of showing off rgb of other cell, would change background color of its own cell. Maybe anyone know how to do it?
我需要这个代码而不是炫耀其他单元格的rgb,会改变自己单元格的背景颜色。也许有人知道该怎么做?
3 个解决方案
#1
5
The MSDN KB says
MSDN KB说
A user-defined function called by a formula in a worksheet cell cannot change the environment of Microsoft Excel. This means that such a function cannot do any of the following: Insert, delete, or format cells on the spreadsheet.
由工作表单元格中的公式调用的用户定义函数无法更改Microsoft Excel的环境。这意味着此类函数无法执行以下任何操作:在电子表格中插入,删除或格式化单元格。
That unfortunately is incorrect!!!
不幸的是,这是不正确的!
YOU CAN change the color of the cell from where the formula is called. Here is an example. This will change the color of the cell to Red
from where the formula is called.
您可以从调用公式的位置更改单元格的颜色。这是一个例子。这将从调用公式的位置将单元格的颜色更改为红色。
The trick is to pass a blank value to the sub as the first parameter (a
in the below case.)
诀窍是将空值传递给sub作为第一个参数(在下面的情况中为a)。
Why does it work?
它为什么有效?
I don't know! But it works :)
我不知道!但它的工作原理:)
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
ScreenShot
EDIT (Credit Where Due): I had seen this thread by Tim Williams long time ago and I had experimented with it and I had achieved lot of other things which that KB article says is not possible.
EDIT(Credit Where Due):我很久以前就已经看过蒂姆·威廉姆斯的这个帖子了,我已经对它进行了实验,并且我已经完成了很多其他知识,而KB文章说这是不可能的。
BTW I played more with it and I was able to make it work without passing a blank string.
顺便说一下,我玩了更多,我能够让它工作,而不会传递空白字符串。
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
EDIT
Followup from Duplicate question and chat (Below comments)
来自重复的问题和聊天(以下评论)
Paste this in a code module and then in cell P20
paste the formula =setit(P20,N20)
将其粘贴到代码模块中,然后在单元格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
Note: I have not done any error handling. I am sure you can take care of that.
注意:我没有做任何错误处理。我相信你可以照顾到这一点。
#2
0
Since you cannot set the color of a cell using a Function called as a UDF, you would need to use a sub instead.
由于无法使用称为UDF的函数设置单元格的颜色,因此需要使用sub。
Pretty simple example:
非常简单的例子:
Function CopyColor(RefCell As Range, DestCell As Range)
DestCell.Interior.Color = RefCell.Interior.Color
End Function
#3
0
Siddharth's solution looks good. If you wish to have such function across the sheet without entering formula, put this code on it's VBA page. It will check changes in cells every time the content changes and you can use it to change the color if the content corresponds to the color format:
Siddharth的解决方案看起来不错。如果您希望在不输入公式的情况下在整个工作表中使用此功能,请将此代码放在其VBA页面上。每次内容更改时,它都会检查单元格中的更改,如果内容对应于颜色格式,则可以使用它来更改颜色:
Private Sub Worksheet_Change(ByVal Target As Range)
' Test if a cell contains the proper formatting
' If it does, assign color
Target.Interior.ColorIndex = Target.Value
End Sub
#1
5
The MSDN KB says
MSDN KB说
A user-defined function called by a formula in a worksheet cell cannot change the environment of Microsoft Excel. This means that such a function cannot do any of the following: Insert, delete, or format cells on the spreadsheet.
由工作表单元格中的公式调用的用户定义函数无法更改Microsoft Excel的环境。这意味着此类函数无法执行以下任何操作:在电子表格中插入,删除或格式化单元格。
That unfortunately is incorrect!!!
不幸的是,这是不正确的!
YOU CAN change the color of the cell from where the formula is called. Here is an example. This will change the color of the cell to Red
from where the formula is called.
您可以从调用公式的位置更改单元格的颜色。这是一个例子。这将从调用公式的位置将单元格的颜色更改为红色。
The trick is to pass a blank value to the sub as the first parameter (a
in the below case.)
诀窍是将空值传递给sub作为第一个参数(在下面的情况中为a)。
Why does it work?
它为什么有效?
I don't know! But it works :)
我不知道!但它的工作原理:)
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
ScreenShot
EDIT (Credit Where Due): I had seen this thread by Tim Williams long time ago and I had experimented with it and I had achieved lot of other things which that KB article says is not possible.
EDIT(Credit Where Due):我很久以前就已经看过蒂姆·威廉姆斯的这个帖子了,我已经对它进行了实验,并且我已经完成了很多其他知识,而KB文章说这是不可能的。
BTW I played more with it and I was able to make it work without passing a blank string.
顺便说一下,我玩了更多,我能够让它工作,而不会传递空白字符串。
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
EDIT
Followup from Duplicate question and chat (Below comments)
来自重复的问题和聊天(以下评论)
Paste this in a code module and then in cell P20
paste the formula =setit(P20,N20)
将其粘贴到代码模块中,然后在单元格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
Note: I have not done any error handling. I am sure you can take care of that.
注意:我没有做任何错误处理。我相信你可以照顾到这一点。
#2
0
Since you cannot set the color of a cell using a Function called as a UDF, you would need to use a sub instead.
由于无法使用称为UDF的函数设置单元格的颜色,因此需要使用sub。
Pretty simple example:
非常简单的例子:
Function CopyColor(RefCell As Range, DestCell As Range)
DestCell.Interior.Color = RefCell.Interior.Color
End Function
#3
0
Siddharth's solution looks good. If you wish to have such function across the sheet without entering formula, put this code on it's VBA page. It will check changes in cells every time the content changes and you can use it to change the color if the content corresponds to the color format:
Siddharth的解决方案看起来不错。如果您希望在不输入公式的情况下在整个工作表中使用此功能,请将此代码放在其VBA页面上。每次内容更改时,它都会检查单元格中的更改,如果内容对应于颜色格式,则可以使用它来更改颜色:
Private Sub Worksheet_Change(ByVal Target As Range)
' Test if a cell contains the proper formatting
' If it does, assign color
Target.Interior.ColorIndex = Target.Value
End Sub