Hi,

a client asked me if I could write a simple macro to insert slides from a hidden presentation to the active, depending on the paper format the user is currently working with. The following code works well on my machine (PPT 2010). But on the client's machines (PPT 2016 or 2019) it only works sometimes - and sometimes my ErMsg appears. I know, "sometimes" is not a precise definition of when it happens and I already asked my client, if he can try to specify what the user was exactly doing, when the error appeared, but they haven't mentioned any regular appearance of the error so far.

However, maybe one of the experienced coders here can have a look on my code and if you have any idea, what the problem might be (and why it does only occur in the newer versions), please let me know.

Thanks a lot!


Option Explicit

Sub InsertSlideFive()


    Dim src As Presentation
    Dim strpath As String
    
On Error GoTo ErMsg


Call FakeObject
    
strpath = Environ("USERPROFILE") & "\AppData\Roaming\Microsoft\AddIns\"


If ActiveWindow.Selection.SlideRange.Count <> 1 Then
        MsgBox "This function can not be used for several slides at the same time"
        Exit Sub
    Else
    
     'Open the source presentation
If ActiveWindow.Presentation.PageSetup.SlideSize = ppSlideSizeOnScreen16x9 Then
    Set src = Presentations.Open(strpath & "PPT-SYSTEM-FILE-WS.pptx")
    
     'Select and copy the slide
    src.Slides(5).Copy
    DoEvents
     
     'Close the source presentation
    With Application.Presentations("PPT-SYSTEM-FILE-WS.pptx")
        .Close
    End With
Else
    Set src = Presentations.Open(strpath & "PPT-SYSTEM-FILE-A4.pptx")
    
     'Select and copy the slide
    src.Slides(5).Copy
    DoEvents
     
     'Close the source presentation
    With Application.Presentations("PPT-SYSTEM-FILE-A4.pptx")
        .Close
    End With
End If
    
    'Go back to active presentation and insert the slide, then go to inserted slide
    ActivePresentation.Slides.Paste (ActiveWindow.View.Slide.SlideIndex + 1)
    DoEvents
    ActiveWindow.View.GotoSlide (ActiveWindow.View.Slide.SlideIndex + 1)
            
    End If
Exit Sub
    
ErMsg:
    MsgBox "Error" 
    
End Sub


Private Sub FakeObject()
'When the user opens a new presentation and clicks the above macro at very first, the document opened by the macro replaces the new presentation and this causes errors.
'The fake object is my workaround to avoid that.


    Dim sld As Slide
    Dim shp As Shape


    On Error Resume Next
    Set sld = Application.ActiveWindow.View.Slide
    Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=0, Top:=0, Width:=1, Height:=1)
    shp.Fill.Visible = msoFalse
    shp.Line.Visible = msoFalse
    shp.Name = "FakeObject"
    
    For Each sld In ActivePresentation.Slides
        If shp.Name = "FakeObject" Then shp.Delete
    Next
End Sub
By the way, there seems to be a difference in how the different PPT-versions handle "SlideIndex + 1". PPT2010 seems to need the +1 to get to the newly inserted slide, while the newer versions don't. But that's a minor issue and I think the solution mentioned (leave out the +1 on the Goto-line) will do it. Will test it soon.