Modify a powerpoint VBA

[avogadro]

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

[John Wilson]

https://www.excelguru.ca/content.php?184

[avogadro]

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 = "D:\aa"
strPath1 = "D:\aaa"
strFileSpec = "*.png"


strTemp = Dir(strPath & strFileSpec)
strTemp1 = Dir(strPath1 & strFileSpec)
Do While strTemp <> ""



Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutCustom)

Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)



Set oPic = oSld.Shapes.AddPicture(FileName:=strPath1 & strTemp1, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=-1, _
Height:=-1)





If lCurrentRound = 1 Then

lCurrentRound = lCurrentRound + 1
End If


strTemp = Dir


Loop


End Sub
















****************************


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

[John Wilson]

You haven't understood the point of cross posting! You need to tell people helping that you have asked on other forums.

That said does each directory have the same number of images and are they all jpgs?