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.
Code:
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