Changing rectangle shape colour using VBA.

Phil Payne

Board Regular
Joined
May 17, 2013
Messages
131
Office Version
  1. 365
Platform
  1. Windows
Hello,
i have a worksheet with 6 Rectangles that launch macros.

I am tryng to set them up so the user can tell which rectangle was last activated, i.e. change the activated rectangle button colour to say yellow and the others remain or return to a 'default' colour - grey.

II achieved this when using Command Buttons but as they were calling 'Custom Views' the buttons would disappear for a while along with much of the data. All would be restored to normal but it took some time.

Part of the command button code:-
VBA Code:
Private Sub CommandButton1_click()

ActiveWorkbook.CustomViews("FY23_24").Show

ActiveSheet.CommandButton1.BackColor = RGB(255, 255, 0) 'YELLOW
ActiveSheet.CommandButton2.BackColor = &HC0C0C0 'grey
ActiveSheet.CommandButton3.BackColor = &HC0C0C0 'grey
ActiveSheet.CommandButton4.BackColor = &HC0C0C0 'grey
ActiveSheet.CommandButton5.BackColor = &HC0C0C0 'grey
ActiveSheet.CommandButton6.BackColor = &HC0C0C0 'grey
Range("A1").Select
End Sub

The next Rectangles Custom View VBA (FY24_25) would have line 2 Yellow and line one grey.

I have the code written presenting the views but I'm stuck with changing the colours. I'm trying to get this Rectangle to change to yellow but I keep getting syntax errors.

VBA Code:
Sub FY23_24()
' FY23_24 Macro
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.OnAction = "FY23_24"
ActiveWorkbook.CustomViews("FY23_24").Show
[B][U]ActiveSheet.Rectangle 1.Color = RGB(255, 255,000)[/U][/B] 'yellow
End Sub

I hope someone can help.

Thanks.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
If the shape already has the macro assigned, it is not necessary to assign it again every time you click on the shape.

Try the following in each shape.

Add at the end the colorall code.


VBA Code:
Sub FY23_24()
' FY23_24 Macro
  ActiveWorkbook.CustomViews("FY23_24").Show
  Call colorall
  ActiveSheet.Shapes("Rectangle 1").Fill.ForeColor.RGB = RGB(255, 255, 0)  'yellow
End Sub

Sub FY23_25()
' FY23_25 Macro
  'here your code
  Call colorall
  ActiveSheet.Shapes("Rectangle 2").Fill.ForeColor.RGB = RGB(255, 255, 0)  'yellow
End Sub

Sub FY23_26()
' FY23_26 Macro
  'here your code
  Call colorall
  ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(255, 255, 0)  'yellow
End Sub

Sub colorall()
  ActiveSheet.Shapes("Rectangle 1").Fill.ForeColor.RGB = RGB(192, 192, 192)  'grey
  ActiveSheet.Shapes("Rectangle 2").Fill.ForeColor.RGB = RGB(192, 192, 192)  'grey
  ActiveSheet.Shapes("Rectangle 3").Fill.ForeColor.RGB = RGB(192, 192, 192)  'grey
  'other shapes
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,162
Messages
6,170,431
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top