Add break in macro

[Thomp]

Let me first preface by saying I know very little VBA but what I am
wanting to do is to create a macro that changes an autoshape color
each time I click on the autoshape. The macro I have below just runs
from the first color to the last. I want to click the shape and change
the color on each click. In fact it needs to loop so that every time I
click the shape it moves between the four colors chosen. I guess I am
looking for some kind of macro break

Here is my code thus far.

ActiveSheet.Shapes("AutoShape 67").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 51
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid

thanks in advance
Thomp

 

[Tom Ogilvy]

ActiveSheet.Shapes("AutoShape 67").Select
Select Case Selection.ShapeRange.Fill.ForeColor.SchemeColor
Case 51
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Case 11
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Case 13
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Case 10
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 51
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Case else
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
End Select

 

[Rob Edwards]

If you are looking for a break, then Insert Stop between each section...

ActiveSheet.Shapes("AutoShape 67").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Stop
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 13
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Stop
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Stop
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 51
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Stop

Rob Edwards

Always look on the bright side of life!

*** Sent via Developersdex http://www.developersdex.com ***

 

[Jon Peltier]

Thomp -

Here's a procedure which checks what color the clicked shape is, and assigns
the next color. Right click the shape, choose Assign Macro, and select
ChangeShapeColor from the list.

Sub ChangeShapeColor()

On Error GoTo ExitSub

With ActiveSheet.Shapes(Application.Caller)
Select Case .Fill.ForeColor.SchemeColor
Case 51
.Fill.ForeColor.SchemeColor = 11
Case 11
.Fill.ForeColor.SchemeColor = 13
Case 13
.Fill.ForeColor.SchemeColor = 10
Case 10
.Fill.ForeColor.SchemeColor = 51
Case Else
.Fill.ForeColor.SchemeColor = 51
End Select
End With

ExitSub:

End Sub

- Jon

 

[Jim Thomlinson]

You can give this a try...

Public Sub ChangeColour()
Dim shp As Shape

Set shp = Sheets("Sheet1").Shapes("AutoShape 1")

With shp.Fill.ForeColor
Select Case .SchemeColor
Case 11
.SchemeColor = 10
Case 10
.SchemeColor = 13
Case 13
.SchemeColor = 51
Case 51
.SchemeColor = 11
Case Else
.SchemeColor = 11
End Select
End With
End Sub

 

[Dave Peterson]

I assigned this macro to the shape.

Option Explicit
Sub TestMe()

Dim myShape As Shape
Dim myColorVals As Variant
Dim myColor As Long
Dim res As Variant

Set myShape = ActiveSheet.Shapes(Application.Caller)

myColorVals = Array(11, 13, 10, 51)

myShape.Fill.Visible = True
myShape.Fill.Solid

res = Application.Match(myShape.Fill.ForeColor.SchemeColor, myColorVals, 0)

If IsError(res) Then
'not one of the specified colors, so use the first
myColor = myColorVals(LBound(myColorVals))
Else
If res > UBound(myColorVals) Then
'go back to the start
myColor = myColorVals(LBound(myColorVals))
Else
'go to the next color
myColor = myColorVals(res)
End If
End If

myShape.Fill.ForeColor.SchemeColor = myColor

End Sub

Set myShape = ActiveSheet.Shapes(Application.Caller)
will be the shape that you clicked on

myColorVals = Array(11, 13, 10, 51)
will be an array(0 to 3)

But res (in the application.match() portion)
will return 1,2,3,4
So if the match is on the first color (11) (element 0 in the array), the next
element will be element #1 (same as what res is equal to).