Insert pics into PPT with file reference stored in Excel

[pe]

I have an Excel sheet with 40 files names in column A. Cell A1 is C:\main\images\4279.jpg, Cell A2 is C:\main\images\37.jpg, Cell A3 etc. down to A40.

I want to write a macro to put these logos in 40 matching powerpoint files. For instance, the 4279.jpg goes 1" down and 2" to the left in 4279.ppt. The 37.jpg logo will go in the same position in the 37.ppt file. Is this possible to do this programatically? Can someone help me with the code? Thank you for the help.

 

[VBslammer]

Here's how to do the powerpoint portion of what you need. The rest will just be a matter of looping through your cells and calling this function:

'********************
'*  §lamKeys §oftware 2000® (mailto: slamkeys@ev1.net)
'*
'*  @CREATED  :   11/18/2002 1:26:09 AM by VBSlammer
'*  @PARAMS   :   strPPT - Full path to powerpoint file
'*                strPicPath - Full path to picture file
'*                intSlideNo - valid slide index
'*  @RETURNS  :   True if successful, False otherwise
'*  @NOTES    :
'*  @MODIFIED :
'********************
Public Function AddPowerPointPicture(ByVal strPPT As String, _
                   ByVal strPicPath As String, _
                   Optional ByVal intSlideNo As Integer = 1) As Boolean
On Error GoTo ErrHandler
  
  Dim ppt As PowerPoint.Application
  Dim pres As PowerPoint.Presentation
  Dim sld As PowerPoint.Slide
  Dim shp As PowerPoint.Shape
  Dim blnValidPPT As Boolean
  Dim strNewName As String
  Dim intTotal As Integer
  Dim intSlash As Integer
  Dim intDot As Integer
  
  ' check image first - abort if not exists
  If Dir(strPicPath) = "" Then
    MsgBox strPicPath & " does not exist, aborting operation.", vbInformation
    GoTo ExitHere
  End If
  
  ' Verify presentation file path
  If Len(strPPT) = 0 Then
    blnValidPPT = False
  ElseIf Dir(strPPT) = "" Then
    blnValidPPT = False
  Else
    blnValidPPT = True
  End If
  
  ' Create the app.
  Set ppt = New PowerPoint.Application
  
  ' set reference to presentation
  If Not blnValidPPT Then
    ' Add new presentation.
    Set pres = ppt.Presentations.Add(False)
    ' Add a slide.
    Set sld = pres.Slides.Add(1, ppLayoutBlank)
  Else
    ' Open the presentation.
    Set pres = ppt.Presentations.Open(strPPT, False, , False)
    
    ' Verify slide number
    intTotal = pres.Slides.Count
    If (intSlideNo < intTotal) Or (intSlideNo > intTotal) Then
      intSlideNo = 1
    End If
    
    ' reference the slide
    Set sld = pres.Slides(intSlideNo)
  End If
  
  ' add the picture
  Set shp = sld.Shapes.AddPicture(strPicPath, False, True, 20, 20, 100, 200)
  
  ' Get image name from path
  intSlash = InStrRev(strPicPath, &quot;\&quot;)
  strNewName = Right(strPicPath, Len(strPicPath) - intSlash)
  intDot = InStr(strNewName, &quot;.&quot;)
  strNewName = Left(strNewName, intDot - 1)
  
  ' Save - you could modify the path.
  pres.SaveAs &quot;C:\&quot; & strNewName & &quot;.ppt&quot;
  
  ' close the presentation.
  pres.Close
  
  ' shut down the app.
  ppt.Quit

  ' Success
  AddPowerPointPicture = True
  
ExitHere:
  On Error Resume Next
  ' dereference
  Set shp = Nothing
  Set sld = Nothing
  Set pres = Nothing
  Set ppt = Nothing
  Exit Function
ErrHandler:
  Debug.Print Err & &quot; - &quot; & Err.Description
  Resume ExitHere
End Function

Sample Calls:

' use an existing ppt as a template:
blnSuccess = AddPowerPointPicture("C:\MyPPT.ppt", "C:\myImage.jpg")

' create a ppt from scratch:
blnSuccess = AddPowerPointPicture("", "C:\myImage.bmp")

If you need help with the Excel code let us know.

VBSlammer

Unemployed in Houston, Texas

 

[pe]

Thank you so much for this. I am not expert enough, however, to know how to make it work.

I have test.xls and test.ppt. In A1:A30 i have file names such as west.jpg, east.jpg...

The jpg's are in C:/test/images/test.xls (worksheet is called images)

The excel and ppt files are in C:/test

From within excel i want to open my template test.ppt, look at the images worksheet range A1, insert the graphic and save the ppt file as rept1.ppt. Open the template again, go to A2 in the worksheet, insert that graphic and save the ppt file as rept2.ppt and so on.

Can you help me with this code. Thank you very much.