I try to use a selected picture on the slide and copy/paste it into the Placeholder (I can not load the picture from a file, it has to be from the slide itself.)
It works fine when I go through the code with F8 step by step. But when I run the macro, the placeholder stays empty.
I tried to set Delays in order to give PPT enough time but no matter how high I make the delay, it won't work (Placeholder doesn't get filled)
Any ideas, what could cause this weird behavior? Better ideas how to place the selected image into the template Placeholder (should work on Mac too though). Thank you for your time!
Sub SetImageIntoPlaceholder()
Dim sImage As Shape
Dim iSl As Integer
Dim oSl As Slide
Dim oPl As Shape
On Error GoTo ErrorHandler
If ActiveWindow.Selection.ShapeRange().Count <> 1 Then
MsgBox "Please select only the picture you wish to place in the Placeholder", vbOKOnly Or vbCritical, Application.Name
Exit Sub
End If
iSl = ActiveWindow.View.Slide.SlideIndex
Set oSl = ActivePresentation.Slides(iSl)
Set sImage = ActiveWindow.Selection.ShapeRange(1)
sImage.Copy
For Each oPl In oSl.Shapes
If oPl.Type = msoPlaceholder Then
With oPl
Select Case oPl.PlaceholderFormat.Type
Case Is = 18
'Its a picture placeholder
Delay 4
oPl.Select
Delay 4
ActiveWindow.View.Paste
Delay 5
'oSl.Shapes.Paste
Application.CommandBars.ExecuteMso ("SlideReset")
'Delay 1.5
'sImage.Delete
Exit Sub
Case Else
' ignore other shape types
End Select
End With
End If
Next oPl
ErrorHandler:
'Resume Next
End Sub
CodePudding user response:
Try adding DoEvents after you copy and after you paste. Also, try separating your copy and paste operations into separate procedures. VBA should wait until the operations are complete before entering and exiting a procedure. I haven't tested it, but maybe something like this . . .
Option Explicit
Sub SetImageIntoPlaceholder()
Dim sImage As Shape
Dim iSl As Integer
Dim oSl As Slide
On Error GoTo ErrorHandler
If ActiveWindow.Selection.ShapeRange().Count <> 1 Then
MsgBox "Please select only the picture you wish to place in the Placeholder", vbOKOnly Or vbCritical, Application.Name
Exit Sub
End If
iSl = ActiveWindow.View.Slide.SlideIndex
Set oSl = ActivePresentation.Slides(iSl)
Set sImage = ActiveWindow.Selection.ShapeRange(1)
sImage.Copy
DoEvents
PastePictureInSlide oSl
ErrorHandler:
'Resume Next
End Sub
Private Sub PastePictureInSlide(ByVal oSl As Slide)
Dim oPl As Shape
For Each oPl In oSl.Shapes
If oPl.Type = msoPlaceholder Then
With oPl
Select Case .PlaceholderFormat.Type
Case Is = 18
'Its a picture placeholder
.Select
ActiveWindow.View.Paste
'oSl.Shapes.Paste
Application.CommandBars.ExecuteMso ("SlideReset")
DoEvents
Exit Sub
Case Else
' ignore other shape types
End Select
End With
End If
Next oPl
End Sub