vba Excel：使用rgb设置单元格的背景颜色和文本颜色
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/40566478/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel: Set background color of cell and text color with rgb
提问by David
I'm write a program that change font and background color due to user request. after received backgroundColorDataand textColorDatai did like to change colors due to user request but i feel there is a better way to make it then what i choose to do (my code is maybe repeating itself) other issue i didn't find an answer for is how to make textColor/backgroundColor more "red" or more "blue"
我正在编写一个程序，根据用户请求更改字体和背景颜色。收到backgroundColorData和textColorData 后，我确实喜欢根据用户请求更改颜色，但我觉得有更好的方法可以做到这一点，然后我选择做（我的代码可能会重复自己）其他问题我没有找到答案是如何使 textColor/backgroundColor 更“红”或更“蓝”
Select Case backgroundColorData
Case Is = "Black"
Selection.Interior.Color = RGB(0, 0, 0)
Case Is = "Red"
Selection.Interior.Color = RGB(255, 0, 0)
Case Is = "Blue"
Selection.Interior.Color = RGB(0, 0, 255)
Case Is = "White"
Selection.Interior.Color = RGB(255, 255, 255)
End Select
Select Case textColorData
Case Is = "Black"
Selection.Font.Color = RGB(0, 0, 0)
Case Is = "Red"
Selection.Font.Color = RGB(255, 0, 0)
Case Is = "Blue"
Selection.Font.Color = RGB(0, 0, 255)
Case Is = "White"
Selection.Font.Color = RGB(255, 255, 255)
End Select
Any help would be appreciated.
任何帮助，将不胜感激。
采纳答案by Tim Williams
Sub tester()
Dim backgroundColorData As String, textColorData As String
backgroundColorData = "Blue"
textColorData = "White"
With Selection
.Interior.Color = NameToRgb(backgroundColorData)
.Font.Color = NameToRgb(textColorData)
End With
End Sub
'map a color name to an rgb value
Function NameToRgb(sName As String) As Long
Dim arrNames, arrRGB, v
arrNames = Array("black", "red", "blue", "white")
arrRGB = Array(RGB(0, 0, 0), RGB(255, 0, 0), _
RGB(0, 0, 255), RGB(255, 255, 255))
v = Application.Match(LCase(sName), arrNames, 0)
If Not IsError(v) Then
NameToRgb = arrRGB(v - 1)
Else
NameToRgb = vbBlack 'default...
End If
End Function
If you want to find an exact color value for something "more red", set the background in a cell to the color you want, select the cell, then in the VB editor Immediate pane type:
如果您想为某些“更红”的东西找到确切的颜色值，请将单元格中的背景设置为您想要的颜色，选择该单元格，然后在 VB 编辑器的“立即”窗格中键入：
? Selection.Interior.Color
Copy the number and use that in place of your RGB() value
复制数字并使用它代替 RGB() 值
EDIT: OK now I see what you mean about making a cell more red...
编辑：好的，现在我明白你的意思是让一个单元格更红......
Sub MoreRed(c As Range)
Dim R As Long, G As Long, B As Long, clr As Long
clr = c.Interior.Color
B = clr \ 65536
G = (clr - B * 65536) \ 256
R = clr - B * 65536 - G * 256
'Debug.Print R, G, B
R = Application.Min(R + 20, 255) 'more red...
c.Interior.Color = RGB(R, G, B)
End Sub
回答by the scion
Welcome to stack overflow.
欢迎使用堆栈溢出。
You can do it with a single function like this-
你可以用这样的单一功能来做到这一点 -
Function setColor(SelectionData As String)
Select Case SelectionData As String
Dim returnValue As String
Case Is = "Black"
returnValue = RGB(0, 0, 0)
Case Is = "Red"
returnValue = RGB(255, 0, 0)
Case Is = "Blue"
returnValue = RGB(0, 0, 255)
Case Is = "White"
returnValue = RGB(255, 255, 255)
End Select
return returnValue
End Function
And then just call your function like this-
然后像这样调用你的函数 -
setColor(textColorData)
