Pasting specific image to corresponding slide using VBA

[isabelle r]

Hello all,

I have a long (about 150 slide) presentation used for interactive educational material, and about 100 of these slides have images (usually screenshots) in the background.

The images are always viewed and copied in the Windows image viewer, then pasted in a specific place in the slide using the small macro below:



Sub Paste_in_Position()
Dim osld As Slide
Set osld = ActiveWindow.Selection.SlideRange(1)
With osld.Shapes.Paste(1)
.Left = 0 * 28.3465 '1 cm=28.3465 pts
.Top = 0.6 * 28.3465 '1 cm=28.3465 pts
.ZOrder msoSendToBack
End With
End Sub



The presentation was so successful it is now being translated to 9 languages, each needing its own version of screenshots in the local language, which even with this macro would require a lot of manual work.

What I'm looking for is to adapt the macro above to do the following:

Go to a folder which I select. The filename of each image is the number of the slide it belongs to (i.e. 3.png goes on slide 3, 46.png goes on slide 46)
Copy an image
Paste the image in its corresponding slide (keep size proportional, but width of the image should fit the width of the slide -- this is automatic when copy-pasting from the Windows image viewer, but I don't know if this is the case when using VBA)
Send the pasted image to the back
Go to the next image and start again until all images in the folder are pasted


I know this may be a tall order, but I'm only asking because I can't find my way around VBA in PPT and because I otherwise have over 900 images to paste manually :banghead:

Thank you for any help,

-Isa

[John Wilson]

You could try this

Put the images into a folder named Images on the Desktop


Sub EveryPresentationInFolder()' Performs some operation on every presentation file in a folder adapted from PPTools.com


Dim sFolder As String ' Full path to folder we'll examine
Dim sFileSpec As String ' Filespec, e.g. *.PNG
Dim sFileName As String ' Name of a file in the folder
Dim oPres As Presentation
Dim lngSld As Long
Dim rayNum() As String
Dim sngL As Single
Dim sngT As Single
Dim sngW As Single
Dim opic As Shape


sFolder = Environ("USERPROFILE") & "\Desktop\Images\" ' This is Images on Desktop
sFileSpec = "*.PNG"
Set oPres = ActivePresentation
sngL = 0
sngT = 0.6 * 28.3465
sngW = oPres.PageSetup.SlideWidth
sFileName = Dir$(sFolder & sFileSpec)
While sFileName <> ""
Debug.Print sFileName
rayNum = Split(sFileName, ".")
lngSld = CLng(rayNum(0))
If lngSld <= oPres.Slides.Count Then
Set opic = oPres.Slides(lngSld).Shapes.AddPicture(FileName:=sFolder & sFileName, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=sngL, _
Top:=sngT, _
Width:=sngW)
opic.LockAspectRatio = True
opic.Width = sngW
opic.Left = 0
opic.Top = sngT
opic.ZOrder (msoSendToBack)
End If
sFileName = Dir()
Wend
End Sub





You will have problems if the image ratio is very different to the slide or the images are not all PNG's

WORK ON A COPY

[isabelle r]

You could try this [...]



John, you just made my day. Works perfectly, and does in a couple of seconds what would have taken me hours manually.

Have a great weekend.

-Isa

[stenin]

This works however, i would like to tweak it a bit. Please help me out.

- The title of the picture is mentioned below the picture-holder likewise I've 4 such placeholders along with titles mentioned below

- The macro should grasp the title name (i.e. Mark Soul) from the power point and search in the directory

- Copy the image and paste it in the picture-holder in the power point

- However, i would need them to do for the subsequent one's as well (loop)

- It should continue even if the title (Mark soul) is not present in the directory

Much appreciated if anyone could sort this out!! :)