Please help with loop

[Tyron]

I am trying to select all shapes on a slide, cut then paste as enhanced
metafile, then move to the next slide in the presentation and do it
again, there is something wrong with my loop


Dim i As Integer
For i = 1 To 5
With ActivePresentation.Slides(i)
ActiveWindow.View.Slide().Shapes.Range().Select
ActiveWindow.View.Slide().Shapes.Range().Cut
'.Slides(2).Shapes.Paste
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
End With
Next i

 

[David M. Marcovitz]

You don't seem to be looping through the shapes on the slide. You might
have to do that rather than trying to cut and paste them all at once.
Also, because you are cutting them as you go, you need to loop through
them backwards. Try something like this (I haven't tested it but it
should give you the right idea):

Dim i As Integer
Dim j As Integer
Dim numShapes As Long
For i = 1 To 5
With ActivePresentation.Slides(i)
.Select 'select the slide so when you paste the shape it is there
numShapes = .Shapes.Count
For j = numShapes to 1 Step -1
.Shapes(j).Cut
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
Next j
End With
Next i

Somehow, I don't think this is quite going to work, but it should point
you into another direction.
--David
--
David M. Marcovitz
Microsoft PowerPoint MVP
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/

 

[Steve Rindsberg]

I am trying to select all shapes on a slide, cut then paste as enhanced
metafile, then move to the next slide in the presentation and do it
again, there is something wrong with my loop

Dim i As Integer
For i = 1 To 5
With ActivePresentation.Slides(i)
ActiveWindow.View.Slide().Shapes.Range().Select
ActiveWindow.View.Slide().Shapes.Range().Cut
'.Slides(2).Shapes.Paste
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
End With
Next i

Problem: you're pasting onto whatever slide is currently in view rather than
the slide following the one you're copying shapes from.

Instead:

Dim i as Long ' PPT uses longs, not integers for slide indices

For i = 1 to 5
ActivePresentation.Slides(i).Shapes.Range().Cut
' paste to the following slide ... i + 1
ActivePresentation.Slides(i+1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
Next

Possible Problem: If there are fewer 6 slides, this will error. You'll want
to build in logic that tests for this, or make your loop something like:

For i = 1 to ActivePresentation.Slides.Count - 1

Problem: (possibly) ... you'll copy all the shapes from slide 1 to 2, then
copy all the shapes from 2 to 3 and so on. In the end, you'll have collected
all the shapes from all slides onto the last slide. Is that what you want to
do?

 

[Tyron]

Hi steve you are closer to what I want than the other guy. I rehashed
my code and came uo with this, Allit must do is select all shapes on
first slide, then cut and paste as enhancedmetafile on the same slide,
then move to the next slide and do the same thing, and finish after
last slide

Sub CopyAsPicture2()
Dim i As Integer
For i = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(i)
ActiveWindow.View.Slide().Shapes.Range().Select
ActiveWindow.View.Slide().Shapes.Range().Cut
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex
+ 1).Select
End With
Next i
End Sub

 

[Tyron]

Hi steve you are closer to what I want than the other guy. I rehashed
my code and came uo with this, Allit must do is select all shapes on
first slide, then cut and paste as enhancedmetafile on the same slide,
then move to the next slide and do the same thing, and finish after
last slide

Sub CopyAsPicture2()
Dim i As Integer
For i = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(i)
ActiveWindow.View.Slide().Shapes.Range().Select
ActiveWindow.View.Slide().Shapes.Range().Cut
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

ActivePresentation.Slides(ActiveWindow.Selection.SlideRange(1).SlideIndex
+ 1).Select
End With
Next i
End Sub

 

[David M. Marcovitz]

You want to get to the slide first, so I simplified your select and moved
it to the beginning of your loop.

Sub CopyAsPicture2()
Dim i As Integer
For i = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(i)
.Select
ActiveWindow.View.Slide().Shapes.Range().Select
ActiveWindow.View.Slide().Shapes.Range().Cut
ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
End With
Next i
End Sub

--David (aka, "The Other Guy")

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

 

[Steve Rindsberg]

Hi steve you are closer to what I want than the other guy. I rehashed
my code and came uo with this, Allit must do is select all shapes on
first slide, then cut and paste as enhancedmetafile on the same slide,
then move to the next slide and do the same thing, and finish after
last slide

OK. You're close then, but don't select anything unless you absolutely need
to. It slows things down and makes the code more failure-prone in some ways.

Sub TryItThisWay()

Dim i as Long

For i = 1 to ActivePresentation.Slides.Count
ActivePresentation.Slides(i).Shapes.Range().Cut
ActivePresentation.Slides(i).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
Next

End Sub