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
|