Search code examples
vbapowerpoint

PPT VBA Routine works in Step Mode, but not in Run


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

Solution

  • 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