Hello! I want that this macro can insert more than one picture per slide.
For example 4 directories with pictures, and it can insert 4 pictures (one from each directory) in each new slide.
Thanks
Sub ImportABunch()

Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape

Dim lCurrentRound As Long
lCurrentRound = 1

' Edit these to suit:
'strPath = "C:\Users\dklaz\Desktop\Prep for China\Factory Pictures\Best Beteck"
strPath = "P:\photos\MakePrints_2008_Japan"
strFileSpec = "*.jpg"

strTemp = Dir(strPath & strFileSpec)

Do While strTemp <> ""

If lCurrentRound = 1 Then ' add a new slide
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)
End If
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)

' Edit the Left/Top values below if you want to place
' the images in specific locations
' Select Case lCurrentRound
' Case 1
' oPic.Left = 0
' oPic.Top = 0
'
' Case 2
' oPic.Left = 100
' oPic.Top = 100
'
' Case 3
' oPic.Left = 200
' oPic.Top = 200
'
' Case 4
' oPic.Left = 300
' oPic.Top = 300
' End Select

'' Or try something like this to assign each
'' image's top/left to a quadrant
Select Case lCurrentRound
Case 1
oPic.Left = 0
oPic.Top = 0

Case 2
oPic.Left = ActivePresentation.PageSetup.SlideWidth / 2
oPic.Top = 0

Case 3
oPic.Left = 0
oPic.Top = ActivePresentation.PageSetup.SlideHeight / 2

Case 4
oPic.Left = ActivePresentation.PageSetup.SlideWidth / 2
oPic.Top = ActivePresentation.PageSetup.SlideHeight / 2
End Select

If lCurrentRound = 4 Then
lCurrentRound = 1
Else
lCurrentRound = lCurrentRound + 1
End If

strTemp = Dir

Loop

End Sub