Public Sub RankSlide(PPPres As Object)
Dim PPSlide As Object
Dim PPSlideObject As Object
Dim indexSlide As Integer
Dim PPApp As Object
Dim counterpage As Integer
Set PPApp = CreateObject("PowerPoint.Application")
Set PPSlide = PPPres.slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
counterpage = 2
Dim i As Integer
Application.ScreenUpdating = False
For i = 3 To PPPres.slides.Count
If InStr(1, PPPres.slides(i).Shapes(1).TextFrame.TextRange, "CO2") = 1 Then
PPPres.slides(i).Cut
PPPres.slides.Paste counterpage + 1
End If
Next i
Application.ScreenUpdating = True
End Sub
viel SpaSS an All VBA programmer :)