随笔- 567 文章- 0 评论- 0 阅读- 55万

VBA 填充颜色和字体颜色

示例 1 - 在 Sub 中使用用户选择的 ( Ribbon ) 颜色

您可能想知道为什么它没有作为变量/方法公开，以便能够像使用 Excel 中的任何其他对象一样访问，并且到目前为止（2020 年 7 月），我找不到任何官方文档来说明原因.

在功能区的“主页”部分，您有两个方便的样本，分别是填充颜色和字体颜色。
色带上的色板能够访问这些而不是在脚本上使用颜色选择器不是很有用吗？
看看下面的脚本 - 这是将这些颜色转换为可用形式的一种方法。

Sub GetWorkbookUserColoursExample()
Dim LP As Integer, ColFG, ColBG As Long
Dim FL_IND, FL_IND_NEG As Double
Dim F_R, F_G, F_B, B_R, B_G, B_B As Integer
Dim IterationsMax As Integer
IterationsMax = 40
Range("A1").Select
Application.CommandBars.ExecuteMso ("CellFillColorPicker")
Range("A2").Select
Application.CommandBars.ExecuteMso ("FontColorPicker")
':: Set font to background colour so we can see it.
Range("A2").Interior.Color = Range("A2").Font.Color
':: Store to variables.
ColFG = Range("A2").Interior.Color
ColBG = Range("A1").Interior.Color
'STORE AS COLOUR COMPONENTS ::
':: FOREGROUND
'R
F_R = ColFG Mod 256
'G
F_G = ((ColFG \ 256) Mod 256)
'B
F_B = (ColFG \ 65536)
':: BACKGROUND
'R
B_R = ColBG Mod 256
'G
B_G = ((ColBG \ 256) Mod 256)
'B
B_B = (ColBG \ 65536)
':: Do a Gradient? ?
 
For LP = 0 To IterationsMax
':: Set factor 0-1 to apply to individual R/G/B components of Forground / Background Colours..
 
FL_IND = LP / IterationsMax
FL_IND_NEG = (IterationsMax - LP) / IterationsMax
Range("C" & LP + 1).FormulaR1C1 = "FG: " & Format(FL_IND, "#0%") & " / BG: " & Format(FL_IND_NEG, "#0%")
Range("D" & LP + 1).Interior.Color = RGB(CInt(FL_IND * F_R), CInt(FL_IND * F_G), CInt(FL_IND * F_B))
Range("E" & LP + 1).Interior.Color = RGB(CInt(FL_IND_NEG * B_R), CInt(FL_IND_NEG * B_G), CInt(FL_IND_NEG * B_B))
Range("F" & LP + 1).Interior.Color = RGB(CInt(FL_IND_NEG * B_R) + CInt(FL_IND * F_R), CInt(FL_IND_NEG * B_G) + CInt(FL_IND * F_G), CInt(FL_IND_NEG * B_B) + CInt(FL_IND * F_B))
Next LP
End Sub

我只是把渐变部分作为使用颜色的一种方法。
有用的部分是两条线
Application.CommandBars.ExecuteMso ("CellFillColorPicker")
Application.CommandBars.ExecuteMso ("FontColorPicker")
这些方法本质上就像您单击色板并将颜色（字体或填充）应用于所选单元格一样。
然后捕获这些，只需访问/保存单元格颜色到变量。
一个更简单的例子 -

':: Select the range 
Range("A2").Select
':: Do the ExecuteMSO ( Set Cell Background/Fill colour )
Application.CommandBars.ExecuteMso ("CellFillColorPicker")
':: Store to variables.
MyBgColourVariable = Range("A2").Interior.Color

也许有一天，我们将能够通过 Workbook / Application 将其引用为 Workbook.Swatch.FillColor 之类的东西。
到目前为止，这是我找到的最可靠的方法。

示例 2 - 按范围内的颜色求和或计数。

由于这是用户定义的函数，您可能需要按 F9 来更新它，因为 Excel 通常不会自动计算。

Excel 甘特日历图表
代码检查引用范围内与其单元格颜色匹配的实例，并基于此返回总和或计数。几年前，我使用类似的东西来跟踪 Excel 日历中的假期。同样，这在性能等方面可能不是那么有效，但可能对某个地方的某个人有用，特别是像上面的示例这样的原型或更简单的表格，其中只有少数几个单元。

Function GetColourSum(MyRange As Range, Optional FontOrBG As Boolean) As Double
Dim MyColour As Long
MyColour = Application.ThisCell.Interior.Color
Dim MyCell As Range
If IsMissing(FontOrBG) Then FontOrBG = False
For Each MyCell In MyRange
If FontOrBG = False And MyCell.Interior.Color = MyColour And IsNumeric(MyCell.Value) Then
GetColourSum = GetColourSum + CDbl(MyCell.Value)
End If
If FontOrBG And MyCell.Font.Color = MyColour And IsNumeric(MyCell.Value) Then
GetColourSum = GetColourSum + CDbl(MyCell.Value)
End If
Next MyCell
End Function
Function GetColourCount(MyRange As Range, Optional FontOrBG As Boolean) As Long
Dim MyColour As Long
MyColour = Application.ThisCell.Interior.Color
Dim MyCell As Range
If IsMissing(FontOrBG) Then FontOrBG = False
Debug.Print "FontOrBG IS : " & FontOrBG
For Each MyCell In MyRange
If FontOrBG = False And MyCell.Interior.Color = MyColour Then
GetColourCount = GetColourCount + 1
End If
 
If FontOrBG And MyCell.Font.Color = MyColour Then
GetColourCount = GetColourCount + 1
End If
Next MyCell
End Function