如何通过VBA代码获取Excel 2012条件格式的颜色标度

时间:2021-12-26 20:23:37

I need to know: how to get colors made by color scale of conditional formatting of Excel 2010 throught VBA code. Those colors will be subsequently assigned by VBA as chart background according to the following image:

我需要知道:如何通过VBA代码获取Excel 2010条件格式的颜色比例。VBA将根据以下图片将这些颜色作为图表背景:

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

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

I did a research on various web sides and:

我对各个网站做了研究

  1. Most people advice how to read color of conditional formatting by method <Cell>.FormatConditions(index that is active).Interior.ColorIndex but in my case it don’t work because of error “Object doesn’t support this property or method”
  2. 大多数人建议如何通过方法 来读取条件格式的颜色。FormatConditions .Interior指数,是活跃的。ColorIndex但在我的例子中它不起作用因为"对象不支持这个属性或方法"
  3. Some people advice to write own computation of colors (based on cells value). I found various ways how to do it, but none of them can compute same colors as was computed previously by excel (same colors as are on previous picture).
  4. 有些人建议自己写颜色的计算(基于单元格值)。我找到了各种方法,但是没有一种可以计算出与之前excel计算的颜色相同的颜色(与之前图片中的颜色相同)。

So I’m asking:

所以我问:

  1. Is there any way to directly ready colors from cells? (or those colors are not accessible for API)
  2. 有没有办法直接从单元格中提取颜色?(或者那些颜色是API无法访问的)
  3. Do you know how to compute same colors as excel compute?
  4. 你知道怎么计算和excel一样的颜色吗?
  5. Do you know any other way how to solve my problem?
  6. 你知道怎么解决我的问题吗?

I believe that it has to work somehow.

我相信这是必须的。

6 个解决方案

#1


4  

if no better answer is provided, you can try this workaround:

如果没有更好的答案,你可以试试这个方法:

  1. link / copy your data to cells under the chart (with formulas like =Sheet1!A1)
  2. 将您的数据链接/复制到图表下的单元格(使用=Sheet1!A1)
  3. apply the same conditional formatting
  4. 应用相同的条件格式
  5. hide the values (with custom number format like "", i.e. empty string literal (2 double quotes))
  6. 隐藏值(使用自定义数字格式如“”,即空字符串文字(两个双引号))
  7. make the chart transparent
  8. 使图表透明
  9. align the cells with the chart
  10. 将单元格与图表对齐。

UPDATE:

更新:

or you can try to compute the color by linear approximation for each R, G, B channel if the conditional format uses only 2 base colors (r1, g1, b1) and (r2, g2, b2) for 2 corner cases which can be

或者,如果条件格式只使用两个底色(r1、g1、b1)和(r2、g2、b2)作为两个角的情况,你也可以尝试通过线性逼近来计算颜色

  • min and max value, e.g.: 0 - 4 000
  • 最小值和最大值,例如:0 - 4000
  • min and max percent, e.g.: 10% - 90%
    (i believe you can use % * [max_value - min_value] to get the actual value)
  • 最小值和最大值百分比,例如:10% - 90%(我相信您可以使用% * [max_value - min_value]来获取实际值)
  • min and max percentile, e.g.: 0th percentile - 100th percentile
  • 最小百分位数和最大百分位数,例如:第0百分位数-第100百分位数

for percent / percentile options you first need to convert an actual value to the percent / percentile value, then if value < min or value > max use the corner colors, otherwise:

对于百分比/百分位数选项,您首先需要将实际值转换为百分比/百分位数值,然后如果值< min或值>最大值使用角颜色,否则:

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

#2


2  

This will copy a picture of a cell to the top-left corner of a chartobject on the same worksheet. Note the picture is linked to the copied cell - if the value or formatting color changes it will change to match.

这将把单元格的图片复制到同一工作表上chartobject的左上角。注意,图片被链接到复制的单元格——如果值或格式颜色发生变化,它将改变以匹配。

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

EDIT: I just tested this with a fairly small 4x8 matrix of cells/charts and the performance is pretty bad! Might be better just pasting without Link:=True ...

编辑:我刚刚测试了一个相当小的4x8矩阵的单元格/图表,性能很差!如果不粘贴链接可能更好:=True…

#3


2  

This is not specific to your problem but is easily modified to solve your problem...

这不是针对你的问题,但很容易修改以解决你的问题……

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

#4


1  

Try this:

试试这个:

<Cell>.DisplayFormat.Interior.Color

This should word with Excel later than 2010.

这应该会比2010年晚一些。

#5


0  

This worked for me, based on the answer of JKirchartz

根据JKirchartz的回答,这对我起了作用。

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

#6


-1  

This is a partial answer to your question. Column 1 of the table below lists Excel's standard 40 colours. Columns 2, 3 and 4 list the red, green and blue components of each colour. So if you want a cell's font to be light orange:

这是对你问题的部分回答。下表的第一列列出了Excel标准的40种颜色。第2、3和4列列出每种颜色的红色、绿色和蓝色成分。因此,如果你想要一个单元格的字体为淡橙色:

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

If you try any other red-green-combination, Excel will match it to the nearest one of these standard colours although Excel's idea of "nearest" does not match mine.

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

Hope this helps if you get the other part of your question answered.

希望这能帮助你回答问题的另一部分。

Colour                Red  Green   Blue
Black                   0      0      0
Light orange          255    153      0
Lime                  153    204      0
Gold                  255    204      0
Bright green            0    255      0
Yellow                255    255      0
Grey 80%               51     51     51
Dark teal               0     51    102
Plum                  153     51    102
Sea green              51    153    102
Dark blue               0      0    128
Dark red              128      0      0
Violet                128      0    128
Teal                    0    128    128
Grey 50%              128    128    128
Grey 40%              150    150    150
Indigo                 51     51    153
Blue-grey             102    102    153
Tan                   255    204    153
Light yellow          255    255    153
Grey 25%              192    192    192
Aqua                   51    204    204
Red                   255      0      0
Rose                  255    153    204
Light green           204    255    204
Blue                    0      0    255
Pink                  255      0    255
Light blue             51    102    255
Lavender              204    153    255
Sky blue                0    204    255
Pale blue             153    204    255
Turquoise               0    255    255
Light turquoise       204    255    255
Dark green              0     51      0
White                 255    255    255
Olive green            51     51      0
Brown                 153     51      0
Orange                255    102      0
Green                   0    128      0
Dark yellow           128    128      0

#1


4  

if no better answer is provided, you can try this workaround:

如果没有更好的答案,你可以试试这个方法:

  1. link / copy your data to cells under the chart (with formulas like =Sheet1!A1)
  2. 将您的数据链接/复制到图表下的单元格(使用=Sheet1!A1)
  3. apply the same conditional formatting
  4. 应用相同的条件格式
  5. hide the values (with custom number format like "", i.e. empty string literal (2 double quotes))
  6. 隐藏值(使用自定义数字格式如“”,即空字符串文字(两个双引号))
  7. make the chart transparent
  8. 使图表透明
  9. align the cells with the chart
  10. 将单元格与图表对齐。

UPDATE:

更新:

or you can try to compute the color by linear approximation for each R, G, B channel if the conditional format uses only 2 base colors (r1, g1, b1) and (r2, g2, b2) for 2 corner cases which can be

或者,如果条件格式只使用两个底色(r1、g1、b1)和(r2、g2、b2)作为两个角的情况,你也可以尝试通过线性逼近来计算颜色

  • min and max value, e.g.: 0 - 4 000
  • 最小值和最大值,例如:0 - 4000
  • min and max percent, e.g.: 10% - 90%
    (i believe you can use % * [max_value - min_value] to get the actual value)
  • 最小值和最大值百分比,例如:10% - 90%(我相信您可以使用% * [max_value - min_value]来获取实际值)
  • min and max percentile, e.g.: 0th percentile - 100th percentile
  • 最小百分位数和最大百分位数,例如:第0百分位数-第100百分位数

for percent / percentile options you first need to convert an actual value to the percent / percentile value, then if value < min or value > max use the corner colors, otherwise:

对于百分比/百分位数选项,您首先需要将实际值转换为百分比/百分位数值,然后如果值< min或值>最大值使用角颜色,否则:

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

#2


2  

This will copy a picture of a cell to the top-left corner of a chartobject on the same worksheet. Note the picture is linked to the copied cell - if the value or formatting color changes it will change to match.

这将把单元格的图片复制到同一工作表上chartobject的左上角。注意,图片被链接到复制的单元格——如果值或格式颜色发生变化,它将改变以匹配。

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

EDIT: I just tested this with a fairly small 4x8 matrix of cells/charts and the performance is pretty bad! Might be better just pasting without Link:=True ...

编辑:我刚刚测试了一个相当小的4x8矩阵的单元格/图表,性能很差!如果不粘贴链接可能更好:=True…

#3


2  

This is not specific to your problem but is easily modified to solve your problem...

这不是针对你的问题,但很容易修改以解决你的问题……

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

#4


1  

Try this:

试试这个:

<Cell>.DisplayFormat.Interior.Color

This should word with Excel later than 2010.

这应该会比2010年晚一些。

#5


0  

This worked for me, based on the answer of JKirchartz

根据JKirchartz的回答,这对我起了作用。

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

#6


-1  

This is a partial answer to your question. Column 1 of the table below lists Excel's standard 40 colours. Columns 2, 3 and 4 list the red, green and blue components of each colour. So if you want a cell's font to be light orange:

这是对你问题的部分回答。下表的第一列列出了Excel标准的40种颜色。第2、3和4列列出每种颜色的红色、绿色和蓝色成分。因此,如果你想要一个单元格的字体为淡橙色:

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

If you try any other red-green-combination, Excel will match it to the nearest one of these standard colours although Excel's idea of "nearest" does not match mine.

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

Hope this helps if you get the other part of your question answered.

希望这能帮助你回答问题的另一部分。

Colour                Red  Green   Blue
Black                   0      0      0
Light orange          255    153      0
Lime                  153    204      0
Gold                  255    204      0
Bright green            0    255      0
Yellow                255    255      0
Grey 80%               51     51     51
Dark teal               0     51    102
Plum                  153     51    102
Sea green              51    153    102
Dark blue               0      0    128
Dark red              128      0      0
Violet                128      0    128
Teal                    0    128    128
Grey 50%              128    128    128
Grey 40%              150    150    150
Indigo                 51     51    153
Blue-grey             102    102    153
Tan                   255    204    153
Light yellow          255    255    153
Grey 25%              192    192    192
Aqua                   51    204    204
Red                   255      0      0
Rose                  255    153    204
Light green           204    255    204
Blue                    0      0    255
Pink                  255      0    255
Light blue             51    102    255
Lavender              204    153    255
Sky blue                0    204    255
Pale blue             153    204    255
Turquoise               0    255    255
Light turquoise       204    255    255
Dark green              0     51      0
White                 255    255    255
Olive green            51     51      0
Brown                 153     51      0
Orange                255    102      0
Green                   0    128      0
Dark yellow           128    128      0