How to paste slides after another presentation slides with specific text?

[iJerry]

Hiii vba express friends, still new to this forum but i need help. :(
I am really new to this powerpoint vba.
I want to paste my slides from presentation 1 to presentation 2 but after a slide with specific text like ("4a) Marketing").
But I am trap in an infinite loop. Please Help :(


Sub test2()

Dim OldPPT As PowerPoint.Presentation
Dim NewPPT As PowerPoint.Presentation
Dim pp AsObject
Dim sld As Slide
Dim shp As Shape

Set pp = GetObject(,"PowerPoint.Application")
Set OldPPT = pp.ActivePresentation
Set NewPPT = pp.Presentations("Testing.pptm")

ForEach sld In NewPPT.Slides
ForEach shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.TextRange.Find("4a"&")"&"Marketing")IsNothingThen

Else
For k =2To OldPPT.Slides.Count
ActivePresentation.Slides(k).Copy
NewPPT.Slides.Paste
Next
EndIf
EndIf
Next shp
Next sld

EndSub

[SamT]

Moderator Bump

[John Wilson]

Don't do it with copy and paste it is very difficult to know which file is active.

I would make sure the old pres is saved and then determine the index of the slide with the text and use InsertFromFile


Sub test2()

Dim OldPPT As PowerPoint.Presentation
Dim NewPPT As PowerPoint.Presentation
Dim k As Long
Dim strPath As String
' Not needed if you are working in PPT
' Set pp = GetObject(, "PowerPoint.Application")
Set OldPPT = ActivePresentation
Set NewPPT = Presentations("Testing.pptm")
'Old Presentation must be saved and up to date
strPath = OldPPT.FullName
k = getIndex(NewPPT, "4a) Marketing")
If k > 1 Then
Call NewPPT.Slides.InsertFromFile(FileName:=strPath, _
Index:=k, SlideStart:=2)
Else
MsgBox "Text not found"
End If
End Sub


Function getIndex(opres As Presentation, strFind As String) As Long
Dim osld As Slide
Dim oshp As Shape
For Each osld In opres.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
If oshp.TextFrame.TextRange Like "*" & strFind & "*" Then
getIndex = osld.SlideIndex
Exit Function
End If
End If
End If
Next oshp
Next osld
End Function

[iJerry]

Thank You John!! You saved me again.
Hours of compiling is now reduced to seconds.
This codes is just what i need.