如何通过VBA代码获取Excel 2012的条件格式的颜色比例所产生的颜色

Question

我需要知道：如何通过VBA代码获取Excel 2010条件格式的颜色比例所产生的颜色。随后，这些颜色将由VBA根据下图分配为图表背景：

www.lnkm.cz/Slozka/Example.jpg http://www.lnkm.cz/Slozka/Example.jpg

我对各种网站进行了研究，并且：

1. 大多数人建议如何通过方法qazxsw poi读取条件格式的颜色，但在我的情况下它不起作用，因为错误“对象不支持此属性或方法”
2. 有些人建议自己编写颜色计算（基于单元格值）。我找到了各种方法，但是没有一种方法可以计算出与之前由excel计算的颜色相同的颜色（与前一张图片相同的颜色）。

所以我问：

1. 有没有办法直接从细胞中准备好颜色？ （或API无法访问这些颜色）
2. 你知道如何计算与excel计算相同的颜色吗？
3. 你知道如何解决我的问题吗？

我相信它必须以某种方式工作。

Answer 1

如果没有提供更好的答案，您可以尝试以下解决方法：

1. 将您的数据链接/复制到图表下的单元格（使用像<Cell>.FormatConditions(index that is active).Interior.ColorIndex这样的公式）
2. 应用相同的条件格式
3. 隐藏值（使用自定义数字格式，如=Sheet1!A1，即空字符串文字（2个双引号））
4. 使图表透明
5. 将细胞与图表对齐

---

更新：

或者你可以尝试通过线性近似计算每个R，G，B通道的颜色，如果条件格式只使用2种基色（r1，g1，b1）和（r2，g2，b2）2个角情况可以是

• ""和min值，例如：0 - 4 000
• max和min百分比，例如：10％ - 90％ （我相信你可以使用％* [max_value - min_value]来获得实际值）
• max和min百分位数，例如：0th百分位数 - 第100百分位数

对于百分比/百分位数选项，您首先需要将实际值转换为百分比/百分位值，然后如果max或value < min使用角落颜色，否则：

value > max

Answer 2

这会将单元格的图片复制到同一工作表上的图表对象的左上角。请注意，图片链接到复制的单元格 - 如果值或格式颜色更改，它将更改为匹配。

r = r1 + (r2 - r1) * (value - min_value) / (max_value - min_value)
g = ...
b = ...

编辑：我刚用一个相当小的4x8单元格/图表矩阵进行测试，性能非常差！可以更好地粘贴没有链接：=真......

Answer 3

这不是特定于您的问题，但很容易修改，以解决您的问题...

Sub Tester()

    CopyLinkedPicToPlot ActiveSheet.Range("E4"), "Chart 2"

End Sub

Sub CopyLinkedPicToPlot(rngCopy As Range, chtName As String)

    Dim cht As ChartObject

    Set cht = ActiveSheet.ChartObjects(chtName)

    rngCopy.Copy
    With rngCopy.Parent.Pictures.Paste(Link:=True)
        .Top = cht.Top
        .Left = cht.Left
    End With

End Sub

Answer 4

试试这个：

Sub CopyCondFill()
    Dim FromSheet As Object
    Dim ToSheet As Object
    Dim FromSheetName as String
    Dim ToSheetName as String
    Dim ToRange As Range
    Dim StrRange As String

    '''Sheet with formatting you want to copy
    FromSheetName = "YourSheetsName"
    Set FromSheet = Application.ThisWorkbook.Sheets(FromSheetName )
        '''Start of range within sheet you want to copy
        FromFirstRow = 3
        FromFirstCol = 2

    '''Sheet you want to copy formatting to
    ToSheetName = "YourSheetsName"
    Set ToSheet = Application.ThisWorkbook.Sheets(ToSheetName)
        '''range to copy formatting to
        ToFirstRow = 3
        ToFirstCol = 2
        '''NOTE: Adjust row/column to take lastrow/lastcol from or enter value manually
        ToLastRow = FromSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ToLastCol = FromSheet.Cells(2, Columns.Count).End(xlToLeft).Column
        Set ToRange = ToSheet.Range(Cells(ToFirstRow, ToFirstCol), Cells(ToLastRow, ToLastCol))

        '''Apply formatting to range
        For Each cell In ToRange
            StrRange = cell.Address(0, 0)
            ToSheet.Range(StrRange).Offset(ToFirstRow - FromFirstRow, ToFirstCol - FromFirstCol).Interior.Color = _
                FromSheet.Range(StrRange).DisplayFormat.Interior.Color
        Next cell

End Sub

这应该在2010年之后用Excel表示。

Answer 5

根据JKirchartz的回答，这对我有用

<Cell>.DisplayFormat.Interior.Color

Answer 6

这是对您的问题的部分答案。下表的第1列列出了Excel的标准40种颜色。第2,3和4列列出了每种颜色的红色，绿色和蓝色成分。因此，如果您希望单元格的字体为浅橙色：

Sub copyBackgroundColors(source As Range, target As Range)
    target.Interior.color = source.DisplayFormat.Interior.color
End Sub

如果您尝试任何其他红绿组合，Excel将匹配这些标准颜色中最接近的一种，尽管Excel的“最近”的想法与我的不匹配。

希望如果您回答问题的其他部分，这会有所帮助。

Cell(Row, Column).Font.Color = RGB(255, 153, 0)