Home > OS >  PPT VBA Routine works in Step Mode, but not in Run
PPT VBA Routine works in Step Mode, but not in Run

Time:05-10

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