Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem setting RGB Values with ShapeRange
I am trying to usa a VBA macro in Excel to set the interior color of a
cell to a specific RGB value. I want to show a user the apparent color of a computed RGB value with an accompanying cell or box. My initial thought was to pick the RGB value from the cells adjacent to the cell I was trying to color with the following code. Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.Interior .Color = RGB(R, G, B) .Pattern = xlSolid End With End Sub This macro works exactly as I hoped, with the exception of the well know problem that the color set is not the specific RGB value, but rather the RGB color of the closest match in the color table. Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May Map to Unexpected Color" refers to this problem, and suggests the use of the ShapeRange object collection instead to get around this problem. I tried this with the following code, Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End With End Sub But get an error on the Selection Line. I am not a VB programmer so am clueless as to what I am doing wrong. Will the ShapeRange command only work on an inserted Shape rather than a spreadsheet cell? This is OK, I can insert a rectangular box, but how do I refer to the cells containing the RGB values? Any help is much appreciated. Bob |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem setting RGB Values with ShapeRange
Sub Macro2()
Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message . .. I am trying to usa a VBA macro in Excel to set the interior color of a cell to a specific RGB value. I want to show a user the apparent color of a computed RGB value with an accompanying cell or box. My initial thought was to pick the RGB value from the cells adjacent to the cell I was trying to color with the following code. Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.Interior .Color = RGB(R, G, B) .Pattern = xlSolid End With End Sub This macro works exactly as I hoped, with the exception of the well know problem that the color set is not the specific RGB value, but rather the RGB color of the closest match in the color table. Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May Map to Unexpected Color" refers to this problem, and suggests the use of the ShapeRange object collection instead to get around this problem. I tried this with the following code, Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End With End Sub But get an error on the Selection Line. I am not a VB programmer so am clueless as to what I am doing wrong. Will the ShapeRange command only work on an inserted Shape rather than a spreadsheet cell? This is OK, I can insert a rectangular box, but how do I refer to the cells containing the RGB values? Any help is much appreciated. Bob |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem setting RGB Values with ShapeRange
Wow, Tom, I am really impressed with your quick response. The code you
supplied works great with only one exception, which I am hoping is simple to correct. The macro works fine for the first cell I color, but when I try to color the 2nd cell in another location, the macro clears the color out of the cell I have previously set. I would like to leave the newly set color and move on to set the color in the new cell. So everything works must as I need, except that the just set cell is being reset upon setting the next cell. Thanks again for your help. Bob On Fri, 26 Aug 2005 16:56:54 -0400, "Tom Ogilvy" wrote: Sub Macro2() Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message ... I am trying to usa a VBA macro in Excel to set the interior color of a cell to a specific RGB value. I want to show a user the apparent color of a computed RGB value with an accompanying cell or box. My initial thought was to pick the RGB value from the cells adjacent to the cell I was trying to color with the following code. Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.Interior .Color = RGB(R, G, B) .Pattern = xlSolid End With End Sub This macro works exactly as I hoped, with the exception of the well know problem that the color set is not the specific RGB value, but rather the RGB color of the closest match in the color table. Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May Map to Unexpected Color" refers to this problem, and suggests the use of the ShapeRange object collection instead to get around this problem. I tried this with the following code, Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End With End Sub But get an error on the Selection Line. I am not a VB programmer so am clueless as to what I am doing wrong. Will the ShapeRange command only work on an inserted Shape rather than a spreadsheet cell? This is OK, I can insert a rectangular box, but how do I refer to the cells containing the RGB values? Any help is much appreciated. Bob |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem setting RGB Values with ShapeRange
It isn't coloring the cell, it is putting a rectangle above the cell and
coloring it. I delete them so they won't build up, but I have removed that part. Sub Macro2() Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) activecell.offset(1,0).Select End Sub Here is a separate macro that deletes them all Sub DeleteShapes() Dim obj as Shape If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message . .. Wow, Tom, I am really impressed with your quick response. The code you supplied works great with only one exception, which I am hoping is simple to correct. The macro works fine for the first cell I color, but when I try to color the 2nd cell in another location, the macro clears the color out of the cell I have previously set. I would like to leave the newly set color and move on to set the color in the new cell. So everything works must as I need, except that the just set cell is being reset upon setting the next cell. Thanks again for your help. Bob On Fri, 26 Aug 2005 16:56:54 -0400, "Tom Ogilvy" wrote: Sub Macro2() Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message ... I am trying to usa a VBA macro in Excel to set the interior color of a cell to a specific RGB value. I want to show a user the apparent color of a computed RGB value with an accompanying cell or box. My initial thought was to pick the RGB value from the cells adjacent to the cell I was trying to color with the following code. Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.Interior .Color = RGB(R, G, B) .Pattern = xlSolid End With End Sub This macro works exactly as I hoped, with the exception of the well know problem that the color set is not the specific RGB value, but rather the RGB color of the closest match in the color table. Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May Map to Unexpected Color" refers to this problem, and suggests the use of the ShapeRange object collection instead to get around this problem. I tried this with the following code, Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End With End Sub But get an error on the Selection Line. I am not a VB programmer so am clueless as to what I am doing wrong. Will the ShapeRange command only work on an inserted Shape rather than a spreadsheet cell? This is OK, I can insert a rectangular box, but how do I refer to the cells containing the RGB values? Any help is much appreciated. Bob |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Problem setting RGB Values with ShapeRange
Slick. I deleted the leftover "End If" in the 5th line and the macro
works great. Thanks again for the quick help. Bob On Fri, 26 Aug 2005 17:31:49 -0400, "Tom Ogilvy" wrote: It isn't coloring the cell, it is putting a rectangle above the cell and coloring it. I delete them so they won't build up, but I have removed that part. Sub Macro2() Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) activecell.offset(1,0).Select End Sub Here is a separate macro that deletes them all Sub DeleteShapes() Dim obj as Shape If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message ... Wow, Tom, I am really impressed with your quick response. The code you supplied works great with only one exception, which I am hoping is simple to correct. The macro works fine for the first cell I color, but when I try to color the 2nd cell in another location, the macro clears the color out of the cell I have previously set. I would like to leave the newly set color and move on to set the color in the new cell. So everything works must as I need, except that the just set cell is being reset upon setting the next cell. Thanks again for your help. Bob On Fri, 26 Aug 2005 16:56:54 -0400, "Tom Ogilvy" wrote: Sub Macro2() Dim obj As Shape Dim R as Long, G as Long, B as long Dim t as Long, l as Long, h as Long, w as Long If ActiveSheet.Shapes.Count 0 Then For Each obj In ActiveSheet.Shapes obj.Delete Next End If R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) t = ActiveCell.Top l = ActiveCell.Left w = ActiveCell.Width h = ActiveCell.Height Set obj = ActiveSheet.Shapes _ .AddShape(msoShapeRectangle, _ l, t, w, h) obj.Fill.Solid obj.Fill.Transparency = 0# obj.Fill.ForeColor.RGB = RGB(R, G, B) End Sub -- Regards, Tom Ogilvy "Bob Gibbons" wrote in message ... I am trying to usa a VBA macro in Excel to set the interior color of a cell to a specific RGB value. I want to show a user the apparent color of a computed RGB value with an accompanying cell or box. My initial thought was to pick the RGB value from the cells adjacent to the cell I was trying to color with the following code. Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.Interior .Color = RGB(R, G, B) .Pattern = xlSolid End With End Sub This macro works exactly as I hoped, with the exception of the well know problem that the color set is not the specific RGB value, but rather the RGB color of the closest match in the color table. Microsoft Knowledge Base Article 71781 (or 213201), "RGB Function May Map to Unexpected Color" refers to this problem, and suggests the use of the ShapeRange object collection instead to get around this problem. I tried this with the following code, Sub Macro2() R = ActiveCell.Offset(0, -3) G = ActiveCell.Offset(0, -2) B = ActiveCell.Offset(0, -1) With Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End With End Sub But get an error on the Selection Line. I am not a VB programmer so am clueless as to what I am doing wrong. Will the ShapeRange command only work on an inserted Shape rather than a spreadsheet cell? This is OK, I can insert a rectangular box, but how do I refer to the cells containing the RGB values? Any help is much appreciated. Bob |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Setting values in a cell | Excel Discussion (Misc queries) | |||
Selection.ShapeRange.IncrementLeft error | Excel Programming | |||
Selection.ShapeRange.IncrementLeft error | Excel Programming | |||
Problem with setting values for SeriesCollection | Excel Programming | |||
Setting values in another workbook | Excel Programming |