Problem setting RGB Values with ShapeRange

Bob Gibbons · 08-26-2005, 05:05 PM

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

Tom Ogilvy · 08-26-2005, 05:05 PM

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" <bob-gibbons@raytheon.com> wrote in message
news:430f72f2.832661515@news.comcast.giganews.com...
> 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
>
>
>

Bob Gibbons · 08-26-2005, 06:05 PM

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" <twogilvy@msn.com>
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" <bob-gibbons@raytheon.com> wrote in message
>news:430f72f2.832661515@news.comcast.giganews.com...
>> 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
>>
>>
>>
>
>

Tom Ogilvy · 08-26-2005, 06:05 PM

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" <bob-gibbons@raytheon.com> wrote in message
news:430f879a.837950093@news.comcast.giganews.com...
> 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" <twogilvy@msn.com>
> 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" <bob-gibbons@raytheon.com> wrote in message
> >news:430f72f2.832661515@news.comcast.giganews.com...
> >> 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
> >>
> >>
> >>
> >
> >
>

Bob Gibbons · 08-26-2005, 06:05 PM

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" <twogilvy@msn.com>
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" <bob-gibbons@raytheon.com> wrote in message
>news:430f879a.837950093@news.comcast.giganews.com...
>> 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" <twogilvy@msn.com>
>> 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" <bob-gibbons@raytheon.com> wrote in message
>> >news:430f72f2.832661515@news.comcast.giganews.com...
>> >> 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
>> >>
>> >>
>> >>
>> >
>> >
>>
>
>