Load Images from Filepath 9In excel) Into an existing Shape in PowerPoint 2010

[pixie_1]

Hi

Hope someone can help on this.

I am creating a powerpoint presentation from Excel. I have a template that I am following (Powerpoint 2010). On it, It has several Shapes. Text and Image containers.
When Pasting the Text from Excel into a Shape, I use this code in Excel VBA:

PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str

My problem is getting the image to load from a file location into the other shapes.
I have a Title in column 3 In Excel e.g. APPLES and the file Path I set C:\

I thing it looks something like this, but can't get the right syntax:

PPT.ActivePresentation.Slides(2).Shapes(3)LoadImage(spath)

Here is all the code so you can see what I am doing.

Sub AddPPT2010()
  On Error Resume Next
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Microsoft Office\Office14\MSPPT.OLB"
Const imgFileName = "PrintIcon"
    Const GUIDRef = "{91493440-5A91-11CF-8700-00AA0060263B}"
    Set PrntIcon = Application.CommandBars.FindControl(ID:=4)
 
    On Error Resume Next  'Ignore Error If Reference Already Established
 
    ThisWorkbook.VBProject.References.AddFromGuid GUIDRef, 2, 10
On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Microsoft Office\Office14\MSPPT.OLB"
Call addPPT2000
Call CreateSlides
End Sub
Sub addPPT2000()
 On Error Resume Next
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Microsoft Office\Office14\MSPPT.OLB"
Const imgFileName = "PrintIcon"
    Const GUIDRef = "{91493440-5A91-11CF-8700-00AA0060263B}"
    Set PrntIcon = Application.CommandBars.FindControl(ID:=4)
 
    On Error Resume Next  'Ignore Error If Reference Already Established
 
    ThisWorkbook.VBProject.References.AddFromGuid GUIDRef, 2, 7
On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Microsoft Office\Office14\MSPPT.OLB"
 
End Sub


Sub CreateSlides()
'Dim the Excel objects
Dim objWorkbook As New Excel.Workbook
Dim objWorksheet As Excel.Worksheet


'Dim the File Path String
Dim strFilePath As String


'Dim the PowerPoint objects
Dim PPT As Object
Dim pptSlide As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
Dim pptNewSlide As PowerPoint.Slide
Dim str As String
Dim Title As String


Set PPT = GetObject(, "PowerPoint.Application")


PPT.Visible = True


'Get the layout of the first slide and set a CustomLayout object
Set pptLayout = PPT.ActivePresentation.Slides(1).CustomLayout


'Run the OpenFile function to get an Open File dialog box. It returns a String containing the file and path.
strFilePath = OpenFile()


'Open the Excel file
Set objWorkbook = Excel.Application.Workbooks.Open(strFilePath)


'Grab the first Worksheet in the Workbook
Set objWorksheet = objWorkbook.Worksheets(1)


'Loop through each used row in Column A
For i = 2 To objWorksheet.Range("A65536").End(xlUp).Row


Set PPT = GetObject(, "PowerPoint.Application")


Set pptNewSlide = PPT.ActivePresentation.Slides.AddSlide(PPT.ActivePresentation.Slides.Count + 1, pptLayout)


 'Get the number of columns in use on the current row
    Dim LastCol As Long
    Dim boldWords As String
    
    
    boldWords = "Release Date: ,Distributor: ,Genre: ,Starring: "
    LastCol = objWorksheet.Rows(i).End(xlToRight).Column
    If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it returns 16384, so correct it


    'Build a string of all the columns on the row
    str = ""
    str = "Release Date: " & str & objWorksheet.Cells(i, 1).Value & Chr(13) & _
    "Distributor: " & objWorksheet.Cells(i, 2).Value & Chr(13) & _
    "Genre: " & objWorksheet.Cells(i, 10).Value & Chr(13) & _
    "Starring: " & objWorksheet.Cells(i, 7).Value & Chr(13) & Chr(13) & _
    objWorksheet.Cells(i, 14).Value
 
 sfile = Cells(i, 3) & ".jpg"


Set PPT = GetObject(, "PowerPoint.Application")


spath = "C:\apples.jpg"




'Write the string to the slide
pptNewSlide.Shapes(2).TextFrame.TextRange.Text = objWorksheet.Cells(i, 3).Value 'This enters the Title
PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str


PPT.ActivePresentation.Slides(2).Shapes(3).LoadImage((spath)) ----This is where I want to add in the apples.jpeg