Change one shape by clicking on series of other shapes

[CompleteNewb]

I'm trying to make sort of a painting demo, where I'd like to have a series
of small boxes of different colors (swatches, if you will) along the bottom
of the slide, and the shape(s) making up the illustration of a house would
change color based on which swatch is clicked.

My DREAM scenario would be to actually have the wall shape of the house
(let's say "Rectangle 4") fly out to the left, and then fly back in with the
new color. OR, have it swell slightly, change to the appropriate color,
then shrink back to the original size and location (these are just ways to
accentuate and draw attention to the fact that the color of THAT wall has
changed, as opposed to the other walls, roof, etc.).

I recorded a macro of selecting the wall rectangle, changing its fill color,
increasing its size, and then reducing its size (and then going through and
changing the "selection" lines of code to ones that would work in slideshow
view, and deleting the unnecessary ending and re-beginnings of the "with"
lines), but it doesn't really animate the rectangle, so it just snaps to the
last size, with no "swelling" animation. Plus, I imagine the code could be
a lot more efficient than a recorded macro. Here's what I have:

Sub RedChange()
With ActivePresentation.SlideShowWindow.View.Slide.Shapes("Rectangle 4")
.Fill.ForeColor.SchemeColor = ppForeground
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Visible = msoTrue
.Fill.Solid
.ScaleWidth 1.46, msoFalse, msoScaleFromMiddle
.ScaleHeight 1.46, msoFalse, msoScaleFromMiddle
.ScaleWidth 0.73, msoFalse, msoScaleFromMiddle
.ScaleHeight 0.73, msoFalse, msoScaleFromMiddle
End With
End Sub

What I'd like to do is the following:

A click on the brown swatch (Rectangle 1) would make Rectangle 4 scale to
125%, change to brown fill color, then scale back down to original size. A
click on the red swatch (Rectangle 2) would make Rectangle 4 scale to 125%,
change fill to red, then scale back down to original size.

And so on, with each swatch shape doing the same thing to Rectangle 4.

It occured to me that I could make 50 or so scale changes, at increments of
..5 or 1%, to make it seem sort of like an animation, but I thought maybe
there's a way to do an animation and color change more efficiently.

Any help, advice, etc. is appreciated, and thanks for reading.

 

[Ute Simon]

I'm trying to make sort of a painting demo, where I'd like to have a

series of small boxes of different colors (swatches, if you will) along
the bottom of the slide, and the shape(s) making up the illustration of a
house would change color based on which swatch is clicked.

My DREAM scenario would be to actually have the wall shape of the house
(let's say "Rectangle 4") fly out to the left, and then fly back in with
the new color. OR, have it swell slightly, change to the appropriate
color, then shrink back to the original size and location (these are just
ways to accentuate and draw attention to the fact that the color of THAT
wall has changed, as opposed to the other walls, roof, etc.).

I recorded a macro of selecting the wall rectangle, changing its fill
color, increasing its size, and then reducing its size (and then going
through and changing the "selection" lines of code to ones that would work
in slideshow view, and deleting the unnecessary ending and re-beginnings
of the "with" lines), but it doesn't really animate the rectangle, so it
just snaps to the last size, with no "swelling" animation. Plus, I
imagine the code could be a lot more efficient than a recorded macro.
Here's what I have:

Sub RedChange()
With ActivePresentation.SlideShowWindow.View.Slide.Shapes("Rectangle 4")
.Fill.ForeColor.SchemeColor = ppForeground
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Visible = msoTrue
.Fill.Solid
.ScaleWidth 1.46, msoFalse, msoScaleFromMiddle
.ScaleHeight 1.46, msoFalse, msoScaleFromMiddle
.ScaleWidth 0.73, msoFalse, msoScaleFromMiddle
.ScaleHeight 0.73, msoFalse, msoScaleFromMiddle
End With
End Sub

What I'd like to do is the following:

A click on the brown swatch (Rectangle 1) would make Rectangle 4 scale to
125%, change to brown fill color, then scale back down to original size. A
click on the red swatch (Rectangle 2) would make Rectangle 4 scale to
125%, change fill to red, then scale back down to original size.

And so on, with each swatch shape doing the same thing to Rectangle 4.

It occured to me that I could make 50 or so scale changes, at increments
of .5 or 1%, to make it seem sort of like an animation, but I thought
maybe there's a way to do an animation and color change more efficiently.

Any help, advice, etc. is appreciated, and thanks for reading.

I am not good at programming PowerPoint, but I know, that animations can't
be recorded. You need to learn the object model of VBA to use them in a
macro.

So I would prefer an animation based solution without programming. How many
"walls" (rectangles) are in your drawing, which you might want to recolor?
How many different swatches do you want to use? If there are not too many of
both, you could use Change Fill Color animations, which are triggered by
clicks on the swatches.

Best regards,
Ute

 

[John Wilson]

Try this and see if its close

Copy this non too elegant code (top of head stuff) and in powerpoint alt +
f11 to go to vb editor
Insert > module and paste in the code

Now give each "swatch" an action setting of run macro "pickup"
Each "wall" an action setting of run macro "placeit"

'code start
Sub pick(oshp As Shape)
oshp.PickUp
End Sub
Sub placeit(oshp As Shape)
leftpos = oshp.Left
For z = 1 To 20
oshp.Left = leftpos - z
DoEvents
Next
oshp.Apply
For z = 20 To 1 Step -1
oshp.Left = leftpos - z
DoEvents
Next
End Sub
'code end
--
email john AT technologytrish.co.uk

"Glass" action buttons - http://www.technologytrish.co.uk/pptbuttons.html
Personalised calendars - http://technologytrish.co.uk/calendars