Ah 2007 act differently to 2010 (where the code works)
Try this (make sure "Shapes(3)" is the left hand shape.
[vba]Sub insertPics()
Dim strFolder As String ' Full path to folder
Dim strName As String
Dim oPres As Presentation
Dim osld As Slide
Dim ocust As CustomLayout
Dim x As Long
' Edit this:
strFolder = "C:\Users\John\Desktop\Pics\" 'note the last \
Set oPres = ActivePresentation
Set osld = oPres.Slides(oPres.Slides.Count)
Set ocust = osld.CustomLayout
strName = Dir$(strFolder & "*.PNG")
While strName <> ""
x = x + 1
With osld.Shapes.AddPicture(strFolder & strName, msoFalse, msoTrue, -1, -1, -1, -1)
.Cut
End With
With osld.Shapes(3)
.Select
End With
ActiveWindow.View.Paste
With osld.Shapes(3).Line
.Visible = True
.ForeColor.RGB = vbWhite
End With
osld.Shapes.Title.TextFrame.TextRange = "Screenshot " & x
strName = Dir()
If strName <> "" Then
Set osld = oPres.Slides.AddSlide(oPres.Slides.Count + 1, ocust)
ActiveWindow.View.GotoSlide osld.SlideIndex
End If
Wend
End Sub[/vba]




Reply With Quote