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