How to run embedded PowerPoint presentation not in full screen

41 Views Asked by At

I have an embedded PowerPoint presentation that runs an animation when double clicked in an Excel sheet. It runs in full screen by default.
I want to I run it in a smaller customized window.

I have another file that runs like I want, but from an external PPT file.

Is it possible with an embedded one?

This is the recorded macro for double clicking the embedded file:

Sub RunEPPT()
    ActiveSheet.Shapes.Range(Array("Object 1")).Select
    Selection.Verb Verb:=xlPrimary
End Sub

This is the one that runs it closer to the ideal format, but from an external PPT File:

Option Explicit
 
Public Sub RunThePowerpointTour()
     '   Constant for the title on the userform
    Const szAppName As String = "PowerPoint Window Tour"
     
     '   Constant for the Powerpoint file to load
    Const szShowName As String = "TestpptShow.pptx"
     
     '   PowerPoint Constant
    Const ppShowTypeInWindow = 1000
     
     '   Late binding to avoid setting reference:
    Dim oPPTApp As Object
    Dim oPPTPres As Object
     
     '   Store this Excel file path, and add a path seperator if needed:
    Dim szShowPath As String
    szShowPath = FixTrailingSeparator(ThisWorkbook.Path)
     
     '   Create the path to the where the show should be:
    Dim szValidShowPath As String
    szValidShowPath = szShowPath & szShowName
    
     '   Initialize an instance of Powerpoint
    On Error Resume Next
    Set oPPTApp = CreateObject("PowerPoint.Application")
     
     '   If we got one okay, continue
    If Not oPPTApp Is Nothing Then
         
         '       With our new instance, open the preset ppt file:
        Set oPPTPres = oPPTApp.Presentations.Open(szValidShowPath, , , False) 
         
         '       If it was found okay, continue on:
        If Not oPPTPres Is Nothing Then  
             
             '           What to do with the presentation?
            With oPPTPres
                 
                With .SlideShowSettings     
                     
                     '                    Show it in it's own window
                    .ShowType = ppShowTypeInWindow
                     
                     '                    Run it of course
                    .Run
                     
                End With
            End With
             
        Else
             
             '           if the presentation could not be shown:
            MsgBox "Presentation could not be found", 16, szAppName
             
        End If
         
    Else
         
         '       If Powerpoint is possibly not available on the machine:
        MsgBox "Powerpoint could not be found", 16, szAppName
         
    End If
    
     '   Explicitly clear memory
    Set oPPTApp = Nothing
    Set oPPTPres = Nothing
End Sub
 
 
Public Function FixTrailingSeparator(Path As String, _
    Optional PathSeparator As String = "\") As String
     '   Xcav8r
     
    Select Case Right(Path, 1)
    Case PathSeparator
        FixTrailingSeparator = Path
    Case Else
        FixTrailingSeparator = Path & PathSeparator
    End Select
     
End Function
0

There are 0 best solutions below