Question : How could you resize & place images automatically in a PowerPoint file at a specific location on each slide?

This is related to "Can you create a PowerPoint file automatically with one image per page from a selected folder?"

The macro from the related question works well, but I'd like to know if could be modified so that it would:
- shrink the images 20% before placing them on the slide &
- place them 2" down from the top on each slide?

Related Solutions: Can you create a PowerPoint file automatically with one image per page from a selected fold…

Answer : How could you resize & place images automatically in a PowerPoint file at a specific location on each slide?

Minor tweak then

CHris

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

           
           
             Sub insertPictures()

On Error GoTo ErrHandler

Dim sPath As String
sPath = InputBox("Enter the path of the folder with pictures")
If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1)

Dim fso As Object
Dim fsoFolder As Object
Dim fsoFile As Object

Dim pptLayout As CustomLayout
Dim i As Integer
i = 1
Set pptLayout = ActivePresentation.Slides(1).CustomLayout
Dim pptSlide As Slide
Dim pptShape As Shape
Const pixelsPerInch As Integer = 96

Set fso = CreateObject("scripting.filesystemobject")
Set fsoFolder = fso.GetFolder(sPath)
For Each fsoFile In fsoFolder.Files
    i = i + 1
    Set pptSlide = ActivePresentation.Slides.AddSlide(i, pptLayout)
    Set pptShape = pptSlide.Shapes.AddPicture(fsoFile.Path, msoFalse, msoTrue, 0, 0)
'    pptShape.ScaleHeight 0.8, msoTrue
    pptShape.Top = pptShape.Top + (pixelsPerInch * 1)
    pptShape.Left = (ActivePresentation.PageSetup.SlideWidth - pptShape.Width) / 2
DoEvents
Next fsoFile

Exit Sub
ErrHandler:
Resume Next

End Sub

           
         