Loop Through Collection to Delete all But one msoPicture Help

[Baiano42]

Greeting PPT gurus:

I'm working on a PPT macro to go through slides 2&3 and loop through the collection to delete the last msoPicture on the slide (the last screen shot from the night before).

This is the code I use for my report:

Sub Daily_Report()

Dim opic As Shape
Dim nn As Integer
Dim sldHeight As Single
Dim sldWidth As Single


'Setup changes for slides 2-3
For nn = 2 To 3
For Each opic In ActivePresentation.Slides(nn).Shapes
If opic.Type = msoPicture Then


With ActivePresentation.PageSetup
sldWidth = .SlideWidth
sldHeight = .SlideHeight
End With


'Resize and position images for curtain section
With opic
.LockAspectRatio = msoFalse
.Height = sldHeight * 0.817778
.Width = sldWidth * 0.98
.Left = sldWidth * 0.01
.Top = sldHeight * 0.017778
.ZOrder (msoSendTofront)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With
Else 'do nothing
End If
Next opic
Next


'Move Line
For Each opic In ActivePresentation.Slides(2).Shapes
If opic.Type = msoLine Then
With opic
.LockAspectRatio = msoFalse
.Left = sldWidth * 0.015
.ZOrder (msoSendToBack)
.Line.Weight = 1.5
.Line.ForeColor.RGB = RGB(255, 0, 0)
End With
Else 'do nothing
End If
Next opic


'Delete old screenshot
With Application.ActivePresentation.Slides(nn).Shapes
For intShape = .Count To 1 Step -1
With .Item(intShape)
If .Type = msoPicture Then .Delete
End With
Next
End With


'Updates links in Powerpoint
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If opic.Type = msoLinkedOLEObject Then opic.LinkFormat.Update
Next opic
Next osld


End Sub

Currently the 'Delete old screenshot is giving me:
"Run-time error '-2147188160 (80048240)':
Slides (unkown member) : Integer out of range. 4 is not in the valid range of 1 to 3."

[Baiano42]

So I'm still struggling to understand how to get VBA to resolve the issue. I have tried the following, but it deletes everything, rather than all but the first msoPicture. Anyone have any suggestions?

'Delete Shapes
For Each opic In ActivePresentation.Slides(2).Shapes
If opic.Type = msoPicture Then
While ActivePresentation.Slides(2).Shapes.Count > 1
ActivePresentation.Slides(2).Shapes(1).Delete
Wend
End If
Next

[John Wilson]

Try something like this:


'Delete old screenshot

With Application.ActivePresentation.Slides(nn).Shapes
For intshape = .Count To 1 Step -1
With .Item(intshape)
If .Type = msoPicture Then
.Delete
'jump out of loop to leave any other pics
Exit For
End If
End With
Next intshape
End With

Also there is no constant msoSendToFront it is msoBringToFront

Also If the picture is in a placeholder it's type will NOT be msoPicture. You should check for a Placeholder and then its ContainedType

[Baiano42]

Thanks for your reply John, though when I used it, it still didn't quite work. Here's the results:
2480724808
It deleted the picture I was wanting to keep in the front (Picture 6) and moved the back picture I'm trying to delete (Picture 5) to the front. I need it to always skip Pic 6, and delete the image following it (whether it be in the second position or the last position, or just pass over this part of the code if there is no picture the one that was just brought in).

[John Wilson]

I guess it's clear to you what you are trying to do but you need to explain more clearly preferably with before and after slide examples. The last added picture would normally be at the front but you seem to be trying to delete pictures further back??

[Baiano42]

Sorry John, I'm fairly new with macros in PPT, I'll keep that in mind next time. Yes sir, I'd like for the macro to be able to take either of the cases below:
2480924810
In the examples above, I have Picture 6 as the new picture I need resized and want to keep, and Picture 5 was the previous report's image that needs to be removed.


The end result should be as follows:
24811

[John Wilson]

So maybe:


Sub deletePic()
Dim osld As Slide
Dim L As Long
Dim P As Long
Dim SldHeight As Long
Dim SldWidth As Long


With ActivePresentation.PageSetup
SldWidth = .SlideWidth
SldHeight = .SlideHeight
End With


For L = 2 To 3
Set osld = ActivePresentation.Slides(L)
With osld
' remove old
For P = 1 To .Shapes.Count
If osld.Shapes(P).Type = msoPicture Then
osld.Shapes(P).Delete
Exit For
End If
Next P


For P = .Shapes.Count To 1 Step -1
If osld.Shapes(P).Type = msoPicture Then
With osld.Shapes(P)
.LockAspectRatio = msoFalse
.Height = SldHeight * 0.817778
.Width = SldWidth * 0.98
.Left = SldWidth * 0.01
.Top = SldHeight * 0.017778
.ZOrder (msoBringToFront)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With
Exit For
End If
Next P


End With
Next L
End Sub

[Baiano42]

That works great! The only problem I encountered is when the image in the back is already deleted, it'll delete the one I put in. Is there a way to add a function to that where if there are two msoPictures in the slide, it will run the code you provided; if there's only one, then just do the resize portion? So for example, if I start with:
24813
It will skip the delete step as there is only one picture present in the slide, and will move to the resize part, resulting with:
24813
Thanks again for all the help John! :bow:

[John Wilson]

You just need a function to count the pictures


Sub deletePic()
Dim osld As Slide
Dim L As Long
Dim P As Long
Dim SldHeight As Long
Dim SldWidth As Long

With ActivePresentation.PageSetup
SldWidth = .SlideWidth
SldHeight = .SlideHeight
End With

For L = 2 To 3
Set osld = ActivePresentation.Slides(L)
With osld
' remove old
If PicCount(osld) = 2 Then
For P = 1 To .Shapes.Count
If osld.Shapes(P).Type = msoPicture Then
osld.Shapes(P).Delete
Exit For
End If
Next P
End If

For P = .Shapes.Count To 1 Step -1
If osld.Shapes(P).Type = msoPicture Then
With osld.Shapes(P)
.LockAspectRatio = msoFalse
.Height = SldHeight * 0.817778
.Width = SldWidth * 0.98
.Left = SldWidth * 0.01
.Top = SldHeight * 0.017778
.ZOrder (msoBringToFront)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With
Exit For
End If
Next P
End With
Next L
End Sub

Function PicCount(osld As Slide) As Long
Dim opic As Shape
For Each opic In osld.Shapes
If opic.Type = msoPicture Then PicCount = PicCount + 1
Next opic
End Function

[Baiano42]

Once again, thanks John, you certainly are a wiz with excel. :thumb