Consulting

Results 1 to 4 of 4

Thread: VBA for adding different images to different existing slides

  1. #1
    VBAX Newbie
    Joined
    Feb 2019
    Posts
    5
    Location

    Post VBA for adding different images to different existing slides

    Hi,

    I am trying to work on some VBA for forming a ppt deck with two goals:
    • A new slide is populated with ONE image per slide from a directory of images
    • Then the slide gets, in the upper right hand corner, another image from another file directory. (acting as a "tag/label" for this slide, it is not the same image for every slide. the directory has a list of numbered images for the "tag/label")


    I am to get the VBA to populate the deck with a new slide for each image in the first directory, but I can not figure out how to the second image in the corner to the existing slide.

    Any advice or help is very much appreciated! Thank you in advance.

    Sub main()
    Dim i As Integer
    Dim arrFilesInFolder As Variant
    arrFilesInFolder = GetAllFilesInDirectory("C:\Users\abui\Desktop\test")
    
    
    For i = LBound(arrFilesInFolder) To UBound(arrFilesInFolder)
        Call AddSlideAndImage(arrFilesInFolder(i))
    Next
    End Sub
    Private Function GetAllFilesInDirectory(ByVal strDirectory As String) As Variant
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim arrOutput() As Variant
    Dim i As Integer
    
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(strDirectory)
    ReDim arrOutput(0)
    i = 1
    'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
     
        'print file path
        arrOutput(i - 1) = objFile.Path
        ReDim Preserve arrOutput(UBound(arrOutput) + 1)
        i = i + 1
    Next objFile
       ReDim Preserve arrOutput(UBound(arrOutput) - 1)
    GetAllFilesInDirectory = arrOutput
    End Function
    
    
    Private Function AddSlideAndImage(ByVal strFile As String)
    Dim objPresentaion As Presentation
    Dim objSlide As Slide
    
    
    Set objPresentaion = ActivePresentation
    
    
    Set objSlide = objPresentaion.Slides.Add(1, PpSlideLayout.ppLayoutChart)
    Call objSlide.Shapes.AddPicture(strFile, msoCTrue, msoCTrue, 20, 50)
    End Function

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    If you have two folder. One for the main Pic and a second for the small images with matching names. Something based on this might work.

    NOTE I changed the path to the folders to work on my laptop and the positions of the small image will need adjusting.

    Sub main()
    Dim i As Integer
    Dim arrFilesInFolder As Variant
    arrFilesInFolder = GetAllFilesInDirectory("C:\Users\info\Desktop\test")
    For i = LBound(arrFilesInFolder) To UBound(arrFilesInFolder)
        Call AddSlideAndImage(arrFilesInFolder(i))
    Next
    End Sub
    Private Function GetAllFilesInDirectory(ByVal strDirectory As String) As Variant
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim arrOutput() As Variant
    Dim i As Integer
    
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(strDirectory)
    ReDim arrOutput(0)
    i = 1
    'loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
     
        Debug.Print objFile.Name
        arrOutput(i - 1) = objFile.Name
        ReDim Preserve arrOutput(UBound(arrOutput) + 1)
        i = i + 1
    Next objFile
       ReDim Preserve arrOutput(UBound(arrOutput) - 1)
    GetAllFilesInDirectory = arrOutput
    End Function
    
    
    
    
    Private Function AddSlideAndImage(ByVal strFile As String)
    Dim objPresentation As Presentation
    Dim objSlide As Slide
    Const folderpath As String = "C:\Users\info\Desktop\test\"
    Const folderpath2 As String = "C:\Users\info\Desktop\test2\"
    Set objPresentation = ActivePresentation
    Set objSlide = objPresentation.Slides.Add(1, PpSlideLayout.ppLayoutChart)
    Call objSlide.Shapes.AddPicture(folderpath & strFile, msoCTrue, msoCTrue, 20, 50)
    Call objSlide.Shapes.AddPicture(folderpath2 & strFile, msoCTrue, msoCTrue, 600, 10, 60, 40)
    End Function
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    Feb 2019
    Posts
    5
    Location
    I am still getting a error at this line of code: "Call objSlide.Shapes.AddPicture(folderpath & strFile, msoCTrue, msoCTrue, 20, 50)"

    Is this related to the first part of the code where the code "gets" the slides in the directory? Is there another path I need to specify here? The error message is " The specified file is not found".

    I have changed all the pertinent file locations back when I ran the code again, so file locations should be fine.

    Thank you so much for your help so far.

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    You need to change folderPath and folderPath2 to reflect the actual paths to the folders you create on YOUR PC. The Paths in the code are MY PC!
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •