Problem with inserting slide from hidden presentation

[RandomGerman]

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.

[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)

Other problems

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


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

[RandomGerman]

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


Other problems

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


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


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




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 ...

[John Wilson]

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


ActiveWindow.ViewType = ppViewNotesPage

ActiveWindow.ViewType = ppViewNormal

[RandomGerman]

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.



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 ...

[John Wilson]

You need to have errors turned off until after the check


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

[RandomGerman]

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

[RandomGerman]

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?

[RandomGerman]

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!