Open Powerpoint within a specified Window in Excel

Hi there,

I've been following the KB article on the VBA Express site named "Run a Powerpoint Show From Excel"

I basically want a powerpoint to continue playing within a specified window inside Excel, I used the above code and to test just named it as it says but it refuses to find the powerpoint (my copy)

Will the above code do what I'm after? I've already tried embedding the powerpoint within the Excel spreadsheet in to a specific area but getting it to run inside that window has been challenging, the best I was able to do was to get it to open powerpoint, however this isn't what I'm after.

If anyone can assist it would be much appreciated.

Thank you

Welcome to the forum!

The kb article link is: http://www.vbaexpress.com/kb/getarticle.php?kb_id=756

It worked fine for me. Did you put your ppt or pptx into that workbook's folder as explained and change the value of the constant? e.g.

Code:

---

'Const szShowName As String = "TestpptShow.ppt"   
Const szShowName As String = "CEES 3884 - Transportation Engineering.pptx"

---

Of course the routine could easily be modified to be called to accept any powerpoint file passed to it.

Hi

Yeah I did and changed the Const name to match the presentation, in fact I renamed my presentation to match the example

Edit: ok I got it working, but this is just opening powerpoint and playing the presentation.

What I'm after is it playing within a specified window/allocated space within Excel, is this possible?

https://msdn.microsoft.com/en-us/vba...rty-powerpoint

Ah ok cool, I know this may sound silly but would I just need to add this code on to the example in the KB or would it work on its own?

Thanks

Short answer, add the parts needed below the .Run but a With as in the example.

Add the 2nd With as With .Run, do as shown for ones you want to set, and end with End With as shown in the example. It is a With, within, a With.

I suspect that these are tied to Windows so you may need to do some math. I am not sure if it is going by pixels or points. See if Application.Left and .Top help any. I noticed they were negative on mine so there may be some translation math needed.

Thanks, seem to be getting a compile error now "Expected end with" and it highlights "End Sub" I did add "End With" but it doesn't seem to like it

This is what the code looks like below .run

Code:

---

"          .Run                    With ActivePresentation.SlideShowSettings
.RangeType = ppShowSlideRange
.StartingSlide = 1
.EndingSlide = 15
.ShowType = ppShowTypeWindow
With .Run
.Left = 0
.Top = 0
.Width = 1280
.Height = 720
End With
'  Explicitly clear memory
    Set oPPTApp = Nothing
    Set oPPTPres = Nothing
End With
End Sub"

---

Please paste code between code tags. Click the # icon on reply toolbar to add the tags. This keeps your structure.

It looks like you left off the period before ActivePresentation. That line also combined with the 1st line. That even happens with the code tags code. I usually edit my post to correct that.

So, it looks like one needs a 3 level With structure. I have not tested this. e.g.

Code:

---

'          What to do with the presentation?           
        With oPPTPres
                With .SlideShowSettings.ShowType
'                    Show it in it's own window
                    .ShowType = ppShowTypeInWindow
'                    Run it of course
                    With .Run
                      'https://msdn.microsoft.com/en-us/vba/powerpoint-vba/articles/slideshowsettings-showtype-property-powerpoint
                      .Left = 0
                      .Top = 0
                      .Width = 1280
                      .Height = 720
                    End With
                End With
            End With

---

I seldom use more than 2 With()'s.

Thank you,

Not getting any errors now but when I click on the presentation window I get the spinning circle as if its going to do something then nothing happens, weird..

Here's the code I'm using:

Code:

---

Option Explicit
Public Sub RunThePowerpointTour()
    '  Constant for the title on the userform
    Const szAppName As String = "PowerPoint.Show.12"
   
    '  Constant for the Powerpoint file to load
    Const szShowName As String = "MET Monthly Display October 2017.pptx"
   
    '  PowerPoint Constant
    Const ppShowTypeInWindow = 500
   
    '  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
           
           
          With oPPTPres
    With .SlideShowSettings.ShowType
        '                    Show it in it's own window
        .ShowType = ppShowTypeInWindow
        '                    Run it of course
        With .Run
            'https://msdn.microsoft.com/en-us/vba/powerpoint-vba/articles/slideshowsettings-showtype-property-powerpoint
            .Left = 500
            .Top = 500
            .Width = 1280
            .Height = 720
        End With
    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

---

I've attempted something else as a backup and that's using a WMP object and I've got that working, the only issue I have now is that the Window keeps resizing and won't stay in the specified size, I've changed it manually via design mode and also within the properties.

I don't suppose you know of another way? I've even tried converting the powerpoint to the exact same size in terms of Width/Height but it just auto resizes.

Thank you

Edit: ok so it appears to re-size based on the resolution of the video and not what you specify within the properties.

Don't seem to be having much luck getting the window size right :(

For my method, you will need to add the Powerpoint object in Tools, References.

Code:

---

Sub Test_run_ppt_file()   
    run_ppt_File ThisWorkbook.Path & "\TestpptShow.ppt"
End Sub
 
Public Function run_ppt_File(PptName As String, Optional tfRun As Boolean = True, _
  Optional ShowType As Integer = 1000, _
  Optional AppWindowstate As Integer = ppWindowMinimized) As Boolean
    'Requires Tools > References... > Microsoft Office PowerPoint xx.0 Object Library
    Dim pPT As New PowerPoint.Application
    Dim pPTopen As PowerPoint.Presentation
    If Dir(PptName) = "" Then Exit Function
    'Set pPT = New PowerPoint.Application
    Set pPT = CreateObject("Powerpoint.Application")
    pPT.Windowstate = AppWindowstate
    Set pPTopen = pPT.Presentations.Open(PptName, , , msoFalse)
    If tfRun = False Then Exit Function
    With pPTopen.SlideShowSettings
      .ShowType = ShowType  'ppShowTypeWindow=2
      With .Run
        .Left = 100
        .Top = 50
        .Width = 400
        .Height = 400
      End With
    End With

---

As I explained before, you might want to consider the current resolution. John Walkenbach shows 2 methods on his site. http://spreadsheetpage.com/index.php...eo_resolution/