Get RGB value of all shapes

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Get RGB value of all shapes

Post by Stefan_Sand »

Hello,

is there a VBA function to get the RGB value of all named shapes in a worksheet?
In my example (taken the US Presidents election) i have a lot of named shapes, which can be colored by clicking them.
Is it possible to get out the value of the colors?

best regards in advance,
Stef
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Get RGB value of all shapes

Post by HansV »

The following function returns an array of 4 numbers: R, G, B and color.

Code: Select all

Function GetRGB(s As String)
    Dim shp As Shape
    Dim r As Long
    Dim ret(1 To 4) As Long
    Application.Volatile
    Set shp = Application.Caller.Parent.Shapes(s)
    r = shp.Fill.ForeColor.RGB
    ret(4) = r
    ret(1) = r Mod 256
    r = r \ 256
    ret(2) = r Mod 256
    ret(3) = r \ 256
    GetRGB = ret
End Function
See the attached version.

US Election 2020.xlsm
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans

User avatar
Stefan_Sand
4StarLounger
Posts: 412
Joined: 29 Mar 2010, 11:50
Location: Vienna, Austria

Re: Get RGB value of all shapes

Post by Stefan_Sand »

Awesome, thank You!

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Get RGB value of all shapes

Post by HansV »

Warning: as with all such functions, it does not update itself automatically when you click a shape. It will update whenever Excel recalculates.
Or to force Excel to do so, change the ChangeColor macro:

Code: Select all

Sub ChangeColor()
    With ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
        Select Case .RGB
            Case RGB(217, 217, 217)
                .RGB = RGB(73, 104, 238)
            Case RGB(73, 104, 238)
               .RGB = RGB(250, 50, 50)
            Case RGB(250, 50, 50)
                .RGB = RGB(191, 191, 191)
            Case RGB(191, 191, 191)
                .RGB = RGB(217, 217, 217)
        End Select
    End With
    ' Recalculate formulas
    ActiveSheet.Calculate
End Sub
Best wishes,
Hans