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
Get RGB value of all shapes
-
- 4StarLounger
- Posts: 412
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Get RGB value of all shapes
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Get RGB value of all shapes
The following function returns an array of 4 numbers: R, G, B and color.
See the attached version.
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
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 412
- Joined: 29 Mar 2010, 11:50
- Location: Vienna, Austria
Re: Get RGB value of all shapes
Awesome, thank You!
-
- Administrator
- Posts: 78236
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Get RGB value of all shapes
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:
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
Hans