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
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