|
Dann mal angenommen in ...
* Spalte A steht der Name
* Spalte B steht ein gültiger Dateipfad auf ein Bild
* Spalte C steht ein gültiger Dateipfadauf ein Bild
Option Explicit
Sub Test()
'VBA Editor Menü: Extras > Verweise... > 'Microsoft PowerPoint X.0 Object Library'
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) = ""
'create new (blank) slide
Set pptSlide = pptPres.Slides.AddSlide(1 + pptPres.Slides.Count, pptPres.Designs(1).SlideMaster.CustomLayouts(7))
'add picture #1
Set pptShp(1) = pptSlide.Shapes.AddPicture( _
Filename:=Trim$(rngCell.Offset(, 1).Text), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, Top:=0)
'add picture #2
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
Den Speicherort der PowerPoint musst du für dich noch festlegen, sowie dir Gedanken um die Positionierung/Anordnung der Bilder machen.
Grüße
|