PDA

View Full Version : Get the shape's RGB value



ooitzechyi
10-04-2016, 09:32 PM
Hi,
I wish to get the color code of shape selected to be show in specify cell.
For eg:
color code of shape selected: RGB (R, G, B)

'I want the code to be show as
Cell (1,2) = R
Cell (1,3) = G
Cell (1,4) = B

I have my code as below but I got error#438: Object doesn't support this property or method

Dim LastRow As Long
Dim ws As Worksheet
Dim shp As Shape
Dim R As Integer
Dim G As Integer
Dim B As Integer


Set shpslt = Selection.ShapeRange()
Set colr = shpslt.Fill.ForeColor.RGB
R = colr Mod 256
G = (colr \ 256) Mod 256
B = (colr \ 256 \ 256) Mod 256

Set ws = Worksheets("Summary")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

Worksheets("Summary").Activate
ws.Range("C" & LastRow).Value = R
ws.Range("D" & LastRow).Value = G
ws.Range("E" & LastRow).Value = B

ws.Range("B" & LastRow).Select
With Selection.Interior
.Color = RGB(R, G, B)
End With

gmayor
10-04-2016, 10:20 PM
The problem relates primarily to the identification of the selected shape. The folllowing will work:


Option Explicit
Sub GetShapeColor()
Dim oShape As Shape
Dim oSel As Variant
Dim LastRow As Long
Dim ws As Worksheet
Dim lngCol As Long
Dim iR As Integer
Dim iG As Integer
Dim iB As Integer

Set oSel = ActiveWindow.Selection
On Error GoTo err_Handler
Set oShape = ActiveSheet.Shapes(oSel.Name)
On Error GoTo 0
lngCol = oShape.Fill.ForeColor

iR = lngCol Mod 256
iG = (lngCol \ 256) Mod 256
iB = (lngCol \ 256 \ 256) Mod 256

Set ws = Worksheets("Summary")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

Worksheets("Summary").Activate
ws.Range("C" & LastRow).Value = iR
ws.Range("D" & LastRow).Value = iG
ws.Range("E" & LastRow).Value = iB

ws.Range("B" & LastRow).Select
With Selection.Interior
.Color = RGB(iR, iG, iB)
End With

lbl_exit:
Exit Sub
err_Handler:
MsgBox "No shape selected!"
Err.Clear
GoTo lbl_exit
End Sub

ooitzechyi
10-04-2016, 11:26 PM
Hi gmayor,
Thanks. The error solved, but still one problem... No result was show... Everything run smooth but the result is empty sheet...

Kenneth Hobs
10-05-2016, 05:03 AM
Graham's code worked for me as does my modification of your code.

Does the activeworkbook have a sheet named Summary? Obviously, a shape must be selected before running as well.

Sub Main()
Dim LastRow As Long
Dim ws As Worksheet
Dim shp As Shape
Dim R As Integer, G As Integer, B As Integer
Dim colr As Double

On Error GoTo EndNow
If VarType(Selection) <> 9 Then Exit Sub

Set shp = ActiveSheet.Shapes(Selection.Name)
colr = shp.Fill.ForeColor.RGB
R = colr Mod 256
G = (colr \ 256) Mod 256
B = (colr \ 256 \ 256) Mod 256

With Worksheets("Summary")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("C" & LastRow).Value = R
.Range("D" & LastRow).Value = G
.Range("E" & LastRow).Value = B
.Range("B" & LastRow).Interior.Color = RGB(R, G, B) 'RGB() or colr
.Select
.Range("B" & LastRow).Select
End With
EndNow:
End Sub

ooitzechyi
10-05-2016, 05:29 PM
Hi Kenneth,
Yes, there will be sheet named summary.
May I know for the 'Selection.Name', does it mean I have to define the shape's name in the code in order to run?
Coz I get error of 1004: Application-defined or object-defined error.

I try to modify the code into
colr = Selection.ShapeRange.Fill.ForeColor

It works~
Though I don't understand why....