Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,600
Default Fill color based on RGB

"Those numbers" are the long-rgb colour values calculated from the
individual RGB attributes. You can use VBA's RGB() function or the formula I
suggested in the earlier post.

It's not necessary to dump those values into cells at all, VBA could
calculate colour-values from individual RGB's and format the (newly created)
shapes with the value temporarily held in memory. However, its probably
better for your purposes to stick with the intermediate step of placing the
values in cells then reading back those values.

In summary, the colour-values can exist anywhere, in memory or some cells,
the shapes do not necessarily need to be placed 'over' those values in
cells, but again probably best to do it that way until you are more familiar
with how to adapt the code for your own purposes.

Following assumes the colour-values are placed in a column of cells in some
sheet. Change the Sheet name and top cell address to suit. The sheet does
not need to be active. The workbook should be active unless to change
'activeworkbook.' to Workbooks("Bookname.xls").

Sub RGBsToShapes()
Dim i As Long
Dim nCol As Long
Dim sName As String
'Dim vArr3, vArr1 ' not used in this routine
Dim rng As Range, cell As Range
Dim ws As Worksheet
Dim shp As Shape


' Place a Shape(Rectangle) over the cell (if it doesn't already exist)
' Size the shape to the cell
' Fill the Shape with the long-rgb colour value in the cell.
' long-rgb colour values should be between =0 to <=16777215

' ActiveSheet.Rectangles.Delete 'start with fresh shapes

'Application.ScreenUpdating = False

Set ws = ActiveWorkbook.Worksheets("Sheet3") ' < change
Set rng = ws.Range("G2") ' < change

With ws
Set rng = .Range(rng, _
.Cells(.Cells(65536, rng.Column).End(xlUp).Row,
rng.Column))
End With

nCol = rng(1).Column

With ws.Shapes
For i = rng.Rows(1).Row To rng.Rows.Count + rng.Rows(1).Row - 1
Set cell = ws.Cells(i, nCol)

If Len(cell) Then
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
End If
Next
End With
Application.ScreenUpdating = True

End Sub


Regards,
Peter T


"ADK" wrote in message
...
Sorry, "different sheet, would would the routine" should read "different
sheet, what would the routine"



"ADK" wrote in message
...
Peter,

The routine places a value in the cells of column D. If I transfer those
numbers to a different sheet, would would the routine be using those
numbers rather than the RGB values in columns A,B & C?

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








Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
change fill color of a range of cells based on color of a cell? DarMelNel Excel Programming 0 March 2nd 06 06:35 PM
countif based on fill color edmcf@mot Excel Worksheet Functions 1 January 13th 06 02:22 AM
Fill Color based on Comment Text MikeF[_2_] Excel Programming 2 November 17th 05 05:36 PM
need a way to set value based on fill color of a cell banderson Excel Programming 1 November 14th 05 03:49 PM
Fill Color each Row based on a Condition Donnie Stone Excel Programming 2 November 2nd 03 01:32 PM


All times are GMT +1. The time now is 11:42 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"