Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
"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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
change fill color of a range of cells based on color of a cell? | Excel Programming | |||
countif based on fill color | Excel Worksheet Functions | |||
Fill Color based on Comment Text | Excel Programming | |||
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 |