AddPicturesToShapes

Oky

Joined
Mar 4, 2023
Messages
1
Reaction score
0
I have this script to move pictures in a folder into shapes on each slide, but it doesn't work, can you help me to make it work the way I want?

Sub AddPicturesToShapes()

Dim shp As Shape
Dim sld As Slide
Dim i As Integer

'Replace "C:\Images\" with your directory path
Const path As String = "D:\Image\"

'Loop melalui setiap slide
For Each sld In ActivePresentation.Slides

'Loop through each slide
For Each shp In sld.Shapes

'Checks whether the shape is a shape that can be filled with images (example: Rectangle, Oval, etc.)
If shp.Type = msoPicture Or shp.Type = msoPlaceholder Then

'Take the shape name and add a number at the end
Dim shapeName As String
shapeName = shp.Name & ".jpg"

'Try inserting an image from a directory with the same name as the shape's name
On Error Resume Next
shp.Fill.UserPicture (path & shapeName)
On Error GoTo 0

'If that fails, change the number in the shape name to .png and try again
If shp.Fill.Type = msoFillError Then
shapeName = shp.Name & ".png"
On Error Resume Next
shp.Fill.UserPicture (path & shapeName)
On Error GoTo 0
End If

End If

Next shp

Next sld

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top