Option Explicit
Sub Test()
Dim ppt As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Set ppt = New PowerPoint.Application
Set pptPres = ppt.Presentations.Add(WithWindow:=msoFalse)
Dim pptShp(1 To 2) As PowerPoint.Shape
Dim rngCell As Excel.Range
Set rngCell = Worksheets("Tabelle1").Range("A1")
Do Until Trim$(rngCell.Text) = ""
Set pptSlide = pptPres.Slides.AddSlide(1 + pptPres.Slides.Count, pptPres.Designs(1).SlideMaster.CustomLayouts(7))
Set pptShp(1) = pptSlide.Shapes.AddPicture( _
Filename:=Trim$(rngCell.Offset(, 1).Text), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, Top:=0)
Set pptShp(2) = pptSlide.Shapes.AddPicture( _
Filename:=Trim$(rngCell.Offset(, 2).Text), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=15, Top:=15)
Set rngCell = rngCell.Offset(1)
Loop
pptPres.SaveAs "D:\MyTestFile"
ppt.Quit
End Sub