This short script runs in PowerPoint VBA. It looks in a given folder for any image and creates a new slide for that image. Once the image has been inserted it determines if the image is portrait or landscape and then resizes the picture, keeping the proportions, to fit the given slide layout as best it can.
Option Explicit Sub CreatePictureSlidesByFolder() 'Define Variables Dim PictureFolder As String Dim CurrentSlide As Slide Dim CurrentFile As String Dim CurrentFileFullName As String Dim AllowedExtensions() As Variant 'Set the Path to the folder of pictures PictureFolder = "\\data\staffdata\ctolley\My Pictures\Sample Pictures" 'Check that the Picture folder path has a trailing \ If Right(PictureFolder, 1) <> "\" Then PictureFolder = PictureFolder & "\" 'Define the allowed picture extensions AllowedExtensions = Array("jpg", "png", "bmp") 'Check that 1 slide exists in the presentation If ActivePresentation.Slides.Count = 0 Then ActivePresentation.Slides.Add 1, ppLayoutTitle ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = PictureFolder End If 'Get the files in the folder CurrentFile = Dir(PictureFolder) While CurrentFile <> "" 'Check that the file extension is allowed If IsStringInArray(GetFileExtension(CurrentFile), AllowedExtensions) Then 'Make the full file name CurrentFileFullName = PictureFolder & CurrentFile 'Add a new slide to the presentation Set CurrentSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank) 'Add the picture to the presentation With CurrentSlide.Shapes.AddPicture(CurrentFileFullName, msoFalse, msoTrue, 0, 0) 'Check if the picture is landscape or portrait If .Width > .Height Then 'Landscape .Width = ActivePresentation.PageSetup.SlideWidth .Left = 0 .Top = (ActivePresentation.PageSetup.SlideHeight - .Height) / 2 Else 'Portrait .Height = ActivePresentation.PageSetup.SlideHeight .Left = (ActivePresentation.PageSetup.SlideWidth - .Width) / 2 .Top = 0 End If End With End If 'Clear the current file CurrentFile = Dir Wend End Sub Public Function GetFileExtension(TheFilePath As String) As String 'Separates the file extension from the file name and returns it. Dim FileParts() As String FileParts = Split(TheFilePath, ".") GetFileExtension = FileParts(UBound(FileParts)) End Function Public Function IsStringInArray(TheString As String, TheArray() As Variant) As Boolean 'Determines if the passed string is in the passed array. Dim ArrIdx As Integer For ArrIdx = LBound(TheArray) To UBound(TheArray) If TheString Like TheArray(ArrIdx) Then IsStringInArray = True Next ArrIdx End Function