Problem with inserting slide from hidden presentation

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!

Code:

---

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.

One problem may be that 16:9 in 2010 is not the same size as 16:9 in later versions.

Your check If ActiveWindow.Presentation.PageSetup.SlideSize = ppSlideSizeOnScreen16x9 Then may fail in 2013 and later because a widescreen slide created in these versions is a custom size (7.5 x 13.333 in)

Other problems

fakeObject is not a great idea, why not just check the active presentation has been saved?

Code:

---

If ActivePresentation.Path = "" Then
MsgBox "Please save"
Exit Sub
End If

---

ALSO

The check for number of slides selected will error if none are selected and throw your error message

Quote:

---

Originally Posted by John Wilson

One problem may be that 16:9 in 2010 is not the same size as 16:9 in later versions.

Your check If ActiveWindow.Presentation.PageSetup.SlideSize = ppSlideSizeOnScreen16x9 Then may fail in 2013 and later because a widescreen slide created in these versions is a custom size (7.5 x 13.333 in)

---

Thank you, John. As far as I understand that would mean the error should not occur in A4 (in case it is the only problem). I will ask them, if that's the case. By the way, is there a possibility to ask for the exact size, something like
If ActiveWindow.Presentation.PageSetup.SlideSize = 7.5 x 13.333 Then

Quote:

---

Originally Posted by John Wilson

Other problems

fakeObject is not a great idea, why not just check the active presentation has been saved?

Code:

---

If ActivePresentation.Path = "" Then
MsgBox "Please save"
Exit Sub
End If

---

---

Well, just because I didn't have that idea yet. ;-) Thank you.

Quote:

---

Originally Posted by John Wilson

ALSO

The check for number of slides selected will error if none are selected and throw your error message

---

Yes, that was what I wanted to happen. I once had PowerPoint crashing, when someone tried to insert a slide while the cursor was placed between two slides in the slide sorter view. An Error message is far better than a crash.

Will ask them for the A4 thing and report here ...

If you want to avoid the select in between slides problem

Check that slide selection count for zero and if it is switch to notes page and immediately back to normal.

This should select the correct slide

Code:

---

ActiveWindow.ViewType = ppViewNotesPage

ActiveWindow.ViewType = ppViewNormal

---

It seems I didn't get it with the slide selection count for zero. When I place the cursor between two slides I still get the Other-error-message in any paper format, even A4, which works well in case one slide is selected.

The other modifications seem to work well in the first instance (on my 2010 machine). I reduced the intention of the macro for testing whether the problem is the paper format differenciation or inserting the slide itself.

Code:

---

Sub InsertSlideFive() 
    Dim src As Presentation
    Dim strpath As String


On Error GoTo ErMsg


If ActivePresentation.Path = "" Then
        MsgBox "Please save presentation"
    Exit Sub
End If
   
    strpath = Environ("USERPROFILE") & "\AppData\Roaming\Microsoft\AddIns\"
   
If ActiveWindow.Selection.SlideRange.Count = 0 Then
    ActiveWindow.ViewType = ppViewNotesPage
    ActiveWindow.ViewType = ppViewNormal
    GoTo DoItAll
ElseIf ActiveWindow.Selection.SlideRange.Count <> 1 Then
        MsgBox "Can't be used for several slides at the same time"
        Exit Sub
    Else
    GoTo DoItAll
End If


DoItAll:
   
    'Open the source presentation
If ActiveWindow.Presentation.PageSetup.SlideSize = ppSlideSizeA4Paper Then
    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
Else
    MsgBox "Paper size is not A4"
    Exit Sub
End If
   
    'Go back to active presentation and paste, then go to pasted slide
    ActivePresentation.Slides.Paste (ActiveWindow.View.Slide.SlideIndex + 1)
    DoEvents
    ActiveWindow.View.GotoSlide (ActiveWindow.View.Slide.SlideIndex)
           
Exit Sub
   
ErMsg:
    MsgBox "Other Error"
   
End Sub

---

I will report what happened ...

You need to have errors turned off until after the check

Code:

---

    If ActivePresentation.Path = "" Then
        MsgBox "Please save presentation"
        Exit Sub
    End If


    strpath = Environ("USERPROFILE") & "\AppData\Roaming\Microsoft\AddIns\"
    On Error Resume Next
    If ActiveWindow.Selection.SlideRange.Count = 0 Then
        ActiveWindow.ViewType = ppViewNotesPage
        ActiveWindow.ViewType = ppViewNormal
    End If


    If ActiveWindow.Selection.SlideRange.Count <> 1 Then
        MsgBox "Can't be used for several slides at the same time"
        Exit Sub
    End If
    On Error GoTo erMsg
    'continue

---

Ah, okay, now I got it. Thank you for clarification.

The version of #5, with John's correction in #6 included, did what it should. Now my next step is to reintegrate the other paper formats via if.

I'm curious, which of the following options is going to happen:
1. Everything will work fine - that would mean, to solve the problem of overwriting a presentation with the one opened in a better way than with my workaround (FakeObject) solved all problems of my macro
2. Errors still occur - because they have to do with the change of size for 16x9
3. There is even more to fix

In case it is the third option, I will probably report ... so far: Thank you, John!

Oh, by the way: There is no easy way to include a special customized paper size in the if-options, is there?

As far as Feedback says by now, everything works well. This would mean, we have no problem with the different slide sizes of 16:9 before and after the change. It seems, the fixes, John suggested to my code, were enough to solve the problem.

Thank you, John!