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:
我对各个网站做了研究
- 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” -
大多数人建议如何通过方法
来读取条件格式的颜色。FormatConditions .Interior指数,是活跃的。ColorIndex但在我的例子中它不起作用因为"对象不支持这个属性或方法" | - 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).
- 有些人建议自己写颜色的计算(基于单元格值)。我找到了各种方法,但是没有一种可以计算出与之前excel计算的颜色相同的颜色(与之前图片中的颜色相同)。
So I’m asking:
所以我问:
- Is there any way to directly ready colors from cells? (or those colors are not accessible for API)
- 有没有办法直接从单元格中提取颜色?(或者那些颜色是API无法访问的)
- Do you know how to compute same colors as excel compute?
- 你知道怎么计算和excel一样的颜色吗?
- Do you know any other way how to solve my problem?
- 你知道怎么解决我的问题吗?
I believe that it has to work somehow.
我相信这是必须的。
6 个解决方案
#1
4
if no better answer is provided, you can try this workaround:
如果没有更好的答案,你可以试试这个方法:
- link / copy your data to cells under the chart (with formulas like
=Sheet1!A1
) - 将您的数据链接/复制到图表下的单元格(使用=Sheet1!A1)
- apply the same conditional formatting
- 应用相同的条件格式
- hide the values (with custom number format like
""
, i.e. empty string literal (2 double quotes)) - 隐藏值(使用自定义数字格式如“”,即空字符串文字(两个双引号))
- make the chart transparent
- 使图表透明
- align the cells with the chart
- 将单元格与图表对齐。
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
andmax
value, e.g.: 0 - 4 000 - 最小值和最大值,例如:0 - 4000
-
min
andmax
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
andmax
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:
如果没有更好的答案,你可以试试这个方法:
- link / copy your data to cells under the chart (with formulas like
=Sheet1!A1
) - 将您的数据链接/复制到图表下的单元格(使用=Sheet1!A1)
- apply the same conditional formatting
- 应用相同的条件格式
- hide the values (with custom number format like
""
, i.e. empty string literal (2 double quotes)) - 隐藏值(使用自定义数字格式如“”,即空字符串文字(两个双引号))
- make the chart transparent
- 使图表透明
- align the cells with the chart
- 将单元格与图表对齐。
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
andmax
value, e.g.: 0 - 4 000 - 最小值和最大值,例如:0 - 4000
-
min
andmax
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
andmax
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