Create Powerpoint slides with pictures from Excel database

[palmers40]

Hello

I would like to create individual Powerpoint slides from a Excel database and also include a picture. The data is standard with Name, Story, Picture filename.
The Powerpoint template will be the same for each slide with the Name as the title, the picture on the left and the Story on the right.

I have 900 rows of data so any help to enable me to create the slides using VBA would be grateful.

Thank You

 

[Yongle]

NOTE - you must add reference to the Microsoft PowerPoint Object Library - in VBA edtor Click on Tools \ References\ scroll down and select the correct box \ click OK

Try this on a copy of your data

Amend name of the sheet if your data is not in sheet named "Sheet1"
Set ws = Sheets("Sheet1")

I suggest you test with about 10 rows of data initially
After initial test amend the code to place the various objects where required and to format each text box as desired etc

The code below should be placed in a NEW module in your workbook

Option Explicit
    Dim pp As PowerPoint.Application, ppPres As PowerPoint.Presentation, ppSlide As PowerPoint.Slide, ppShape As PowerPoint.Shape

Sub NewPresentation()
'worksheet range
    Dim ws As Worksheet, Cel As Range
    Set ws = Sheets("Sheet1")
'create presentation
    Set pp = New PowerPoint.Application
    Set ppPres = pp.Presentations.Add
    pp.Visible = True 'msoTrue
'add slides
    For Each Cel In ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
        Call AddASlide(Cel, Cel.Offset(, 1), Cel.Offset(, 2))
    Next
End Sub

Private Sub AddASlide(Person As Range, Story As Range, PathToPic As Range)
    On Error Resume Next
'create the slide
    ppPres.Slides.Add ppPres.Slides.Count + 1, ppLayoutBlank
    Set ppSlide = ppPres.Slides(ppPres.Slides.Count)
'add namebox & text
    Set ppShape = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=100, Top:=50, Width:=200, Height:=50)
    ppShape.TextFrame.TextRange.Text = Person
    ppShape.TextFrame.TextRange.Font.Size = 30
    ppShape.TextFrame.TextRange.Font.Bold = True
'add storybox & text
    Set ppShape = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=600, Top:=100, Width:=200, Height:=50)
    ppShape.TextFrame.TextRange.Text = Story
'insert picture
    ppSlide.Shapes.AddPicture Filename:=PathToPic, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=100, Top:=150, Width:=200, Height:=300
End Sub

NOTE
Above was tested with data set out EXACTLY as per picture in post#1 and it worked without any issues
If for any reason your initial 10 row test fails to run (or misbehaves) then post the data used in support of any questions you may have

 

[Yongle]

just spotted a little gremlin which is doing no damage but 'msoTrue should be removed in this line

pp.Visible = True 'msoTrue

 

[Yongle]

You may prefer that the image aspect ratio does not change when resized
Code below makes the height 300
Maximum image width set to 450 (height reduced to match)

'picture
    ppSlide.Shapes.AddPicture Filename:=PathToPic, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=100, Top:=150
    With ppSlide.Shapes(ppSlide.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Height = 300
        If .Width > 450 Then .Width = 450
    End With

 

[palmers40]

Thank you so much Yongle, works a treat.

I know enough to be able to resize the text boxes now as well.

Cheers

 

[bbrimberry]

I'm really glad I found this post. great stuff here.

how would someone change the picture code if pictures were out on the web?
say I had links like this https://www.dogbreedslist.info/uploads/dog-pictures/american-eskimo-dog-2.jpg
in the photofilename column?

 

[bbrimberry]

what if i had more columns ?
how would i adjust this??