Creating a looping macro for Power Point

[LostInOutlook]

Hi I recieve a power Point file evey month. Every month each page has 2
slides on it One on top of the other. Also they are oversized. So I wrote
this marco which deletes one and reszie the one left. Great, now I want to
loop through the presentation and do iT on each page. Here is the code I am
using for one page at a time. How do i get to index to the next slide?

Also, if any one has ideas on why it is happening the first place I Listen.

Thanks in advance

'islide = 3
'Do While islide <= 134
' AcctiveWindow.View.GotoSlide = islide
ActiveWindow.Selection.SlideRange.Shapes("Picture 3").Select
ActiveWindow.Selection.ShapeRange.Delete
ActiveWindow.Selection.SlideRange.Shapes("Picture 2").Select
ActiveWindow.Selection.ShapeRange.ScaleWidth 0.91, msoFalse,
msoScaleFromTopLeft
ActiveWindow.Selection.ShapeRange.ScaleHeight 0.88, msoFalse,
msoScaleFromTopLeft
' islide = islide + 1

'Loop
End Sub

 

[David M. Marcovitz]

I assume you mean that each slide contains two shapes, not two slides. Try
something like this:

Sub DeletePict3AndScalePict2
Dim sld As Slide

For Each sld In ActivePresentation.Slides
sld.Shapes("Picture 3").Delete
sld.Shapes("Picture 2").ScaleWidth 0.91, msoFalse, msoScaleFromTopLeft
sld.Shapes("Picture 2").ScaleHeight 0.88, msoFalse,
msoScaleFromTopLeft
Next sld
End Sub

This assumes (as does your code) that every slide in the presentation has
shapes named "Picture 3" and "Picture 2." If not, you'll have to figure out
some way to identify which shapes you want to delete and scale.

--David

David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/

 

[LostInOutlook]

David,

Thanks for the help. This does not advance to the next slide. How do I do
that portion? I even tried a ctrl-A and then running the macro. It only
changed the frist slide.

 

[David M. Marcovitz]

My code does advance to the next slide (not by actually flipping you
through slide by slide but doing what you ask to each slide). I suspect
that the problem is that the first slide has something named "Picture 2"
and something named "Picture 3," but your second slide does not (the
pictures probably have different names). If that is the case, I think
the code will bomb out after the first slide.

Tell us more about the slides. If the pictures on the slides are not all
named "Picture 2" and "Picture 3," then we need some other way of
identifying them. Are they, perhaps, the only two pictures on the slide?
If so, a simple macro, could go through each shape, look for the first
picture and resize it, then look for the second picture and delete it.
But if there are more than two pictures, the code needs a way
(unfortunately, computers are stupid and can't read minds) to determine
which picture you want to delete and which picture you want to resize.

--David

--
David M. Marcovitz
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/

 

[Brian Reilly, MS MVP]

Here's a sample piece of code that iterates through every shape on
every slide in a presentation.

You'll want to edit the code inside the "Substitute" comments to work
the way you want.

Another piece of advice would be not to used hard-coded shape names
since they are not likely to be consistent across all slides.

Sub Iterate_Through_All_Shapes_And_Read_Tags()

'PURPOSE: Refers to EACH object on EACH page and checks for a tags
..name
'Then if it is a StickyStyle Name
'Developer: Brian Reilly January 2001
Dim iShape As Integer
Dim iSlide As Integer
Dim iTags As Integer


For iSlide = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(iSlide)
For iShape = 1 To
ActiveWindow.Presentation.Slides(iSlide).Shapes.Count
'No need to select the object in order to use strShape

With
ActiveWindow.Presentation.Slides(iSlide).Shapes(iShape)
'''''''''''Substitute whatever code to the End of Substitute
For iTags = 1 To .Tags.Count

If .Tags.Name(iTags) = "STICKYSTYLE" Then
MsgBox "The shape " &
ActiveWindow.Presentation.Slides(iSlide) _
.Shapes(iShape).Name & " has a
Tags.Name of " & Chr(13) _
& .Tags.Name(iTags) & Chr(13) _
& "and has a Tags.Value of " &
Chr(13) & .Tags.Value(iTags)
''PROCEED WITH NEXT TAG AND NEXT OBJECT
End If

Next iTags
End With

''''''''''''End of Substitute
Next iShape
End With
Next iSlide

End Sub


Sorry about the line breaks. A clean copy of this is on my web site at
http://reillyand.com/Support Pages/sub_iterate.htm

Brian Reilly, PowerPoint MVP