Hallo,
ich habe es jetzt mal umgedeht, das Objekt muss nun den Titel "beibehalten" haben und auf der Folie vorhanden sein, damit diese nicht gelöscht wird. Ich habe das Makro ein wenig mit Debug Informationen aufgebohrt, damit man im Direktbereich nachvollziehen kann was genau passiert.
Bitte teste noch einmal mit deiner Präsentation, was genau passiert:
Option Explicit
Public Sub deleteSlides()
Dim sld As Slide
Dim shp As Shape
Dim blnDelete As Boolean
For Each sld In ActivePresentation.Slides
Debug.Print "Analysiere Slide '" & sld.Name & "'"
blnDelete = True
For Each shp In sld.Shapes
Debug.Print vbTab & "Shape gefunden, Titel: '" & shp.Title & "'"
If shp.Title = "beibehalten" Then
Debug.Print vbTab & vbTab & "Titel des Shapes passt, Folie '" & sld.Name & "' wird beibehalten"
blnDelete = False
End If
Next shp
If blnDelete Then
Debug.Print vbTab & vbTab & "Kein Objekt mit dem Titel 'beibehalten gefunden' - Lösche Folie '" & sld.Name & "'"
sld.Delete
End If
Next sld
Set shp = Nothing
Set sld = Nothing
End Sub
Meine Ausgabe im Direktbereich:
Analysiere Slide 'Slide1'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide1' wird beibehalten
Analysiere Slide 'Slide3'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide3' wird beibehalten
Analysiere Slide 'Slide6'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide6' wird beibehalten
Analysiere Slide 'Slide32'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Kein Objekt mit dem Titel 'beibehalten gefunden' - Lösche Folie 'Slide32'
Analysiere Slide 'Slide9'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide9' wird beibehalten
Analysiere Slide 'Slide12'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide12' wird beibehalten
Analysiere Slide 'Slide14'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide14' wird beibehalten
Analysiere Slide 'Slide34'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Kein Objekt mit dem Titel 'beibehalten gefunden' - Lösche Folie 'Slide34'
Analysiere Slide 'Slide18'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide18' wird beibehalten
Analysiere Slide 'Slide19'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide19' wird beibehalten
Analysiere Slide 'Slide20'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Shape gefunden, Titel: 'beibehalten'
Titel des Shapes passt, Folie 'Slide20' wird beibehalten
Analysiere Slide 'Slide37'
Shape gefunden, Titel: ''
Shape gefunden, Titel: ''
Kein Objekt mit dem Titel 'beibehalten gefunden' - Lösche Folie 'Slide37'
Mir ist jedoch auch aufgefallen, dass manche Folien nicht gelöscht werden, obwohl das Shape nicht gefunden wird. Dann einfach das Makro noch einmal laufen lassen. Zu viele Folien wurden jedoch nie gelöscht.
Viele Grüße
|