VBA for adding different images to different existing slides

[ta91888]

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

[John Wilson]

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

[ta91888]

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.

[John Wilson]

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!