More RGB Woes
 

With help from Michael Pierron and Peter T., I have made progress on
getting RGB colors. I select a rectangle on the screen. The
rectangle's lines may be a scheme color or RGB colors, same for its
fill. I try to detect the scheme color first. If that gives an error,
I try to detect the RGB colors. This works fine unless BOTH the line
and the fill are RGB colors. IN that case, I get an error when the
code tries to get Selection.ShapeRange.Line.ForeColor.SchemeColor. The
error is Run Time Error 70 Permission Denied. A wierd error to get.
What's more, the error trap fails and execution stops. Help! Thanks,
James

On Error GoTo GetRGBLine
MyMsg = "Line Color " &
Selection.ShapeRange.Line.ForeColor.SchemeColor _
& vbLf
GoTo SchemeFill
GetRGBLine:
MyMsg = RGB_SettingsLine() & vbLf
SchemeFill:

More RGB Woes
 

I should have mentioned that the rectangle is a regular Excel
rectangle, but is drawn as a free-form object. James

More RGB Woes
 

I don't follow your error handling, guess an error is occurring in the
handler itself.

As we can predict an error returning the schemecolor a little brute force
might be excused.

Function SchemeRGB(oFormat As Object, arr() As Long)
' 0-7 vb colours, eg vbRed
' 8 - 63 colorindex + 7 (linked to palette)
' 64/65 system black / white
' 66+ other win-system colors
' -1 no schemecolor (error), a fixed RGB color

On Error Resume Next
arr(0) = -1
arr(0) = oFormat.ForeColor.SchemeColor
arr(1) = oFormat.ForeColor.RGB

arr(2) = -1
arr(2) = oFormat.BackColor.SchemeColor
arr(3) = oFormat.BackColor.RGB

End Function

Sub Test()
Dim shp As Shape, obj As Object
Dim na(0 To 3) As Long
Dim s$

For Each shp In ActiveSheet.Shapes

s = vbTab & "Schemecolor" & vbTab & "RGB" & vbCr

Set obj = shp.Fill ' FillFormat
SchemeRGB obj, na
s = s & "Fill-1" & vbTab & vbTab & na(0) & vbTab & na(1) & vbCr
s = s & "Fill-2" & vbTab & vbTab & na(2) & vbTab & na(3) & vbCr

Set obj = shp.Line ' LineFormat
SchemeRGB obj, na
s = s & "Line-1" & vbTab & vbTab & na(0) & vbTab & na(1) & vbCr
s = s & "Line-2" & vbTab & vbTab & na(2) & vbTab & na(3)

MsgBox s, , shp.Name
Next
End Sub

This is quick & dirty for illustration, normally would cater for declaring
FillFormat & LineFormat objects respectively. Also best to resume normal
error handling immediately after forcing through the anticipated errors.

Although 2x4 RGB colours can be returned whether or not they are visible
will depend on many other factors.

Can I ask what's the big picture objective, apart of course from returning
rgb/schemecolor.

Regards,
Peter T

"Zone" wrote in message
ups.com...
With help from Michael Pierron and Peter T., I have made progress on
getting RGB colors. I select a rectangle on the screen. The
rectangle's lines may be a scheme color or RGB colors, same for its
fill. I try to detect the scheme color first. If that gives an error,
I try to detect the RGB colors. This works fine unless BOTH the line
and the fill are RGB colors. IN that case, I get an error when the
code tries to get Selection.ShapeRange.Line.ForeColor.SchemeColor. The
error is Run Time Error 70 Permission Denied. A wierd error to get.
What's more, the error trap fails and execution stops. Help! Thanks,
James

On Error GoTo GetRGBLine
MyMsg = "Line Color " &
Selection.ShapeRange.Line.ForeColor.SchemeColor _
& vbLf
GoTo SchemeFill
GetRGBLine:
MyMsg = RGB_SettingsLine() & vbLf
SchemeFill:

More RGB Woes
 

Hi Peter,
I believe I understand my problem now. The scheme color was giving
me a fit. I've been working on a drawing program for Excel and I end
up with a bunch of freeform drawing objects on the sheet. I want to
select one of these and get its line and fill colors, whether it is a
scheme or RGB. I actually want the RGB numbers as shown on the custom
colors form, so I'll probably use Michael's code for that as it has
been working well. I'll use your code to get the scheme color since it
avoids the problem I've been having with that. Thanks again! James

Peter T wrote:
I don't follow your error handling, guess an error is occurring in the
handler itself.

As we can predict an error returning the schemecolor a little brute force
might be excused.

Function SchemeRGB(oFormat As Object, arr() As Long)
' 0-7 vb colours, eg vbRed
' 8 - 63 colorindex + 7 (linked to palette)
' 64/65 system black / white
' 66+ other win-system colors
' -1 no schemecolor (error), a fixed RGB color

On Error Resume Next
arr(0) = -1
arr(0) = oFormat.ForeColor.SchemeColor
arr(1) = oFormat.ForeColor.RGB

arr(2) = -1
arr(2) = oFormat.BackColor.SchemeColor
arr(3) = oFormat.BackColor.RGB

End Function

Sub Test()
Dim shp As Shape, obj As Object
Dim na(0 To 3) As Long
Dim s$

For Each shp In ActiveSheet.Shapes

s = vbTab & "Schemecolor" & vbTab & "RGB" & vbCr

Set obj = shp.Fill ' FillFormat
SchemeRGB obj, na
s = s & "Fill-1" & vbTab & vbTab & na(0) & vbTab & na(1) & vbCr
s = s & "Fill-2" & vbTab & vbTab & na(2) & vbTab & na(3) & vbCr

Set obj = shp.Line ' LineFormat
SchemeRGB obj, na
s = s & "Line-1" & vbTab & vbTab & na(0) & vbTab & na(1) & vbCr
s = s & "Line-2" & vbTab & vbTab & na(2) & vbTab & na(3)

MsgBox s, , shp.Name
Next
End Sub

This is quick & dirty for illustration, normally would cater for declaring
FillFormat & LineFormat objects respectively. Also best to resume normal
error handling immediately after forcing through the anticipated errors.

Although 2x4 RGB colours can be returned whether or not they are visible
will depend on many other factors.

Can I ask what's the big picture objective, apart of course from returning
rgb/schemecolor.

Regards,
Peter T

"Zone" wrote in message
ups.com...
With help from Michael Pierron and Peter T., I have made progress on
getting RGB colors. I select a rectangle on the screen. The
rectangle's lines may be a scheme color or RGB colors, same for its
fill. I try to detect the scheme color first. If that gives an error,
I try to detect the RGB colors. This works fine unless BOTH the line
and the fill are RGB colors. IN that case, I get an error when the
code tries to get Selection.ShapeRange.Line.ForeColor.SchemeColor. The
error is Run Time Error 70 Permission Denied. A wierd error to get.
What's more, the error trap fails and execution stops. Help! Thanks,
James

On Error GoTo GetRGBLine
MyMsg = "Line Color " &
Selection.ShapeRange.Line.ForeColor.SchemeColor _
& vbLf
GoTo SchemeFill
GetRGBLine:
MyMsg = RGB_SettingsLine() & vbLf
SchemeFill: