Get the shape's RGB value

[ooitzechyi]

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]

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]

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]

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]

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....