Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Different approach? Fill color based on RGB (PeterT?)
Peter,
The routine places a value in the cells of column D (under the shape). If I transfer those numbers to a different sheet, what would the routine be if using those numbers rather than the RGB values in columns A,B & C? ...the numbers would be in column F of this new sheet Thanks ADK "Peter T" <peter_t@discussions wrote in message ... "ADK" wrote We are currently using Excel 2000 Er, OK. As it happens the routine I posted was written in Excell 2000. Not sure what you are trying to convey. Regards, Peter T "Peter T" <peter_t@discussions wrote in message ... In pre-XL2007 you are limited to 56 unique palette colours which can be customized, hence why I asked how many unique colours you might require. There's no limit to unique RGB's in shapes on a sheet (subject resources). Following adds shapes, if don't already exist, sized to cells in the fourth column and fills with the RGB. Try "Test" on a new sheet Sub Test() With Range("A2:c500") .Formula = "=INT(RAND()*255)" .Value = .Value End With MultiRGBs End Sub Sub MultiRGBs() Dim i As Long Dim nCol As Long Dim sName As String Dim vArr3, vArr1 Dim rng As Range, cell As Range Dim shp As Shape 'part1 'write the long RGB colour values in Col-D ' assumes first red-value is in A2, with green & blue in B2:C2 Set rng = Range("A2") Set rng = Range(rng, _ Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) vArr3 = rng.Resize(, 3).Value ReDim vArr1(1 To UBound(vArr3), 1 To 1) For i = 1 To UBound(vArr3) vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3)) Next rng.Offset(, 3).Value = vArr1 ' part 2 ' if shape name clr&cell-ref doesn't exist add it ' fill the RGB with the long colour value in the cell in col-D 'ActiveSheet.Rectangles.Delete 'start with fresh shapes 'Application.ScreenUpdating = False ' Set rng = Range("A2") ' Set rng = Range(rng, _ ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) nCol = rng(1).Column + 3 With ActiveSheet.Shapes For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1 Set cell = Cells(i, nCol) sName = "clr" & cell.Address(0, 0) Set shp = Nothing On Error Resume Next Set shp = .Item(sName) On Error GoTo 0 If shp Is Nothing Then Set shp = .AddShape(1, cell.Left, cell.Top, _ cell.Width, cell.Height) shp.Name = sName End If With shp.Fill.ForeColor If .RGB < cell Then .RGB = cell End With Next End With Application.ScreenUpdating = True End Sub I separated the above into two parts for demo purposes. Instead of "part1" you could use this formula filled down. =(r + g*256 + b*256*256) A Worksheet change event could change the filled RGB colour if any r, G or B value changes (adapt the above into the change event). It's quite a bit more complicated but it's also possible to scatter UDF's in cells to be filled with unique RGB's (goes against UDF rules!). Regards, Peter T "ADK" wrote in message ... What I would like to do is take the colors from AutoCAD (ACI) and create a layer color table with a color sample in a cell. There are 256 colors in autocad so to answer your question, 256. I am working on converting AutoCAD Color Index (ACI) into RGB numbers. "Peter T" <peter_t@discussions wrote in message ... ADK, how many unique colours do you envisage (envision) you will need in total in the workbook. Mike, the approach you suggested applies the 'nearest' RGB that already exists in the palette. IOW one of the existing palette colours will be applied, of which there are 46 in a default palette. Regards, Peter T "ADK" wrote in message ... A beginner at this vba stuff. Looking to color a cell based on RGB values Column A has the R numbers Column B has the G numbers Column C has the B numbers Column D will be the where the cells fill color is based on the values entered in columns A thru C. I'll have 256 rows ...each row will end up having a different fill color based on the values Example A1=255 B1=255 C1=0 D1={cell fill color would be yellow} A2=255 B2=191 C2=0 D2={cell fill color would be orange} Thanks in advance for your help! ADK |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Different approach? Fill color based on RGB (PeterT?)
See my follow-up in your original thread.
Normally it's best to continue in the same thread, rather than starting a new thread merely to continue the same topic. I only saw this message by chance. From the additional information you provided below it appears your colour-values will be in col-F on some sheet, so in the new routine I posted (in the original thread) change "G2" to "F2" or whatever the first cell is. Regards, Peter T "ADK" wrote in message ... Peter, The routine places a value in the cells of column D (under the shape). If I transfer those numbers to a different sheet, what would the routine be if using those numbers rather than the RGB values in columns A,B & C? ...the numbers would be in column F of this new sheet Thanks ADK "Peter T" <peter_t@discussions wrote in message ... "ADK" wrote We are currently using Excel 2000 Er, OK. As it happens the routine I posted was written in Excell 2000. Not sure what you are trying to convey. Regards, Peter T "Peter T" <peter_t@discussions wrote in message ... In pre-XL2007 you are limited to 56 unique palette colours which can be customized, hence why I asked how many unique colours you might require. There's no limit to unique RGB's in shapes on a sheet (subject resources). Following adds shapes, if don't already exist, sized to cells in the fourth column and fills with the RGB. Try "Test" on a new sheet Sub Test() With Range("A2:c500") .Formula = "=INT(RAND()*255)" .Value = .Value End With MultiRGBs End Sub Sub MultiRGBs() Dim i As Long Dim nCol As Long Dim sName As String Dim vArr3, vArr1 Dim rng As Range, cell As Range Dim shp As Shape 'part1 'write the long RGB colour values in Col-D ' assumes first red-value is in A2, with green & blue in B2:C2 Set rng = Range("A2") Set rng = Range(rng, _ Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) vArr3 = rng.Resize(, 3).Value ReDim vArr1(1 To UBound(vArr3), 1 To 1) For i = 1 To UBound(vArr3) vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3)) Next rng.Offset(, 3).Value = vArr1 ' part 2 ' if shape name clr&cell-ref doesn't exist add it ' fill the RGB with the long colour value in the cell in col-D 'ActiveSheet.Rectangles.Delete 'start with fresh shapes 'Application.ScreenUpdating = False ' Set rng = Range("A2") ' Set rng = Range(rng, _ ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) nCol = rng(1).Column + 3 With ActiveSheet.Shapes For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1 Set cell = Cells(i, nCol) sName = "clr" & cell.Address(0, 0) Set shp = Nothing On Error Resume Next Set shp = .Item(sName) On Error GoTo 0 If shp Is Nothing Then Set shp = .AddShape(1, cell.Left, cell.Top, _ cell.Width, cell.Height) shp.Name = sName End If With shp.Fill.ForeColor If .RGB < cell Then .RGB = cell End With Next End With Application.ScreenUpdating = True End Sub I separated the above into two parts for demo purposes. Instead of "part1" you could use this formula filled down. =(r + g*256 + b*256*256) A Worksheet change event could change the filled RGB colour if any r, G or B value changes (adapt the above into the change event). It's quite a bit more complicated but it's also possible to scatter UDF's in cells to be filled with unique RGB's (goes against UDF rules!). Regards, Peter T "ADK" wrote in message ... What I would like to do is take the colors from AutoCAD (ACI) and create a layer color table with a color sample in a cell. There are 256 colors in autocad so to answer your question, 256. I am working on converting AutoCAD Color Index (ACI) into RGB numbers. "Peter T" <peter_t@discussions wrote in message ... ADK, how many unique colours do you envisage (envision) you will need in total in the workbook. Mike, the approach you suggested applies the 'nearest' RGB that already exists in the palette. IOW one of the existing palette colours will be applied, of which there are 46 in a default palette. Regards, Peter T "ADK" wrote in message ... A beginner at this vba stuff. Looking to color a cell based on RGB values Column A has the R numbers Column B has the G numbers Column C has the B numbers Column D will be the where the cells fill color is based on the values entered in columns A thru C. I'll have 256 rows ...each row will end up having a different fill color based on the values Example A1=255 B1=255 C1=0 D1={cell fill color would be yellow} A2=255 B2=191 C2=0 D2={cell fill color would be orange} Thanks in advance for your help! ADK |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Different approach? Fill color based on RGB (PeterT?)
Thanks
"Peter T" <peter_t@discussions wrote in message ... See my follow-up in your original thread. Normally it's best to continue in the same thread, rather than starting a new thread merely to continue the same topic. I only saw this message by chance. From the additional information you provided below it appears your colour-values will be in col-F on some sheet, so in the new routine I posted (in the original thread) change "G2" to "F2" or whatever the first cell is. Regards, Peter T "ADK" wrote in message ... Peter, The routine places a value in the cells of column D (under the shape). If I transfer those numbers to a different sheet, what would the routine be if using those numbers rather than the RGB values in columns A,B & C? ...the numbers would be in column F of this new sheet Thanks ADK "Peter T" <peter_t@discussions wrote in message ... "ADK" wrote We are currently using Excel 2000 Er, OK. As it happens the routine I posted was written in Excell 2000. Not sure what you are trying to convey. Regards, Peter T "Peter T" <peter_t@discussions wrote in message ... In pre-XL2007 you are limited to 56 unique palette colours which can be customized, hence why I asked how many unique colours you might require. There's no limit to unique RGB's in shapes on a sheet (subject resources). Following adds shapes, if don't already exist, sized to cells in the fourth column and fills with the RGB. Try "Test" on a new sheet Sub Test() With Range("A2:c500") .Formula = "=INT(RAND()*255)" .Value = .Value End With MultiRGBs End Sub Sub MultiRGBs() Dim i As Long Dim nCol As Long Dim sName As String Dim vArr3, vArr1 Dim rng As Range, cell As Range Dim shp As Shape 'part1 'write the long RGB colour values in Col-D ' assumes first red-value is in A2, with green & blue in B2:C2 Set rng = Range("A2") Set rng = Range(rng, _ Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) vArr3 = rng.Resize(, 3).Value ReDim vArr1(1 To UBound(vArr3), 1 To 1) For i = 1 To UBound(vArr3) vArr1(i, 1) = RGB(vArr3(i, 1), vArr3(i, 2), vArr3(i, 3)) Next rng.Offset(, 3).Value = vArr1 ' part 2 ' if shape name clr&cell-ref doesn't exist add it ' fill the RGB with the long colour value in the cell in col-D 'ActiveSheet.Rectangles.Delete 'start with fresh shapes 'Application.ScreenUpdating = False ' Set rng = Range("A2") ' Set rng = Range(rng, _ ' Cells(Cells(65536, rng.Column).End(xlUp).Row, rng.Column)) nCol = rng(1).Column + 3 With ActiveSheet.Shapes For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1 Set cell = Cells(i, nCol) sName = "clr" & cell.Address(0, 0) Set shp = Nothing On Error Resume Next Set shp = .Item(sName) On Error GoTo 0 If shp Is Nothing Then Set shp = .AddShape(1, cell.Left, cell.Top, _ cell.Width, cell.Height) shp.Name = sName End If With shp.Fill.ForeColor If .RGB < cell Then .RGB = cell End With Next End With Application.ScreenUpdating = True End Sub I separated the above into two parts for demo purposes. Instead of "part1" you could use this formula filled down. =(r + g*256 + b*256*256) A Worksheet change event could change the filled RGB colour if any r, G or B value changes (adapt the above into the change event). It's quite a bit more complicated but it's also possible to scatter UDF's in cells to be filled with unique RGB's (goes against UDF rules!). Regards, Peter T "ADK" wrote in message ... What I would like to do is take the colors from AutoCAD (ACI) and create a layer color table with a color sample in a cell. There are 256 colors in autocad so to answer your question, 256. I am working on converting AutoCAD Color Index (ACI) into RGB numbers. "Peter T" <peter_t@discussions wrote in message ... ADK, how many unique colours do you envisage (envision) you will need in total in the workbook. Mike, the approach you suggested applies the 'nearest' RGB that already exists in the palette. IOW one of the existing palette colours will be applied, of which there are 46 in a default palette. Regards, Peter T "ADK" wrote in message ... A beginner at this vba stuff. Looking to color a cell based on RGB values Column A has the R numbers Column B has the G numbers Column C has the B numbers Column D will be the where the cells fill color is based on the values entered in columns A thru C. I'll have 256 rows ...each row will end up having a different fill color based on the values Example A1=255 B1=255 C1=0 D1={cell fill color would be yellow} A2=255 B2=191 C2=0 D2={cell fill color would be orange} Thanks in advance for your help! ADK |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Fill color based on RGB | Excel Programming | |||
change fill color of a range of cells based on color of a cell? | Excel Programming | |||
countif based on fill color | Excel Worksheet Functions | |||
need a way to set value based on fill color of a cell | Excel Programming | |||
Fill Color each Row based on a Condition | Excel Programming |