PowerPoint Presentation in Excel UserForm

[bdmangum]

I'm attempting to display a slideshow within an excel user form. I grabbed some old VB6 code off the web and have been attempting to modify it to work. I can get the slideshow to run in a seperate window, but I can't get it to run in the frame on my userform.

Currently when the code hits the "With .Run" line the slidehsow opens fulscreen, then after the first slide resizes to the specified dimensions. first off, I don't see why it would load fullscreen since I set the .ShowType to speaker. Secondly how do I set it to load in the frame? I can get it to load in the same screen location as the frame, but not in the frame.

here's my current code:

' ------------------------------------------------------------------------
' Copyright ©1999-2008, Shyam Pillai, All Rights Reserved.
' ------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' ------------------------------------------------------------------------
 
Option Explicit
Const APP_NAME = "PowerPoint in VB window"
Const SHOW_FILE = "C:\Documents and Settings\bmangum\Desktop\Cranfill_Transformation.ppt"


' PowerPoint Constants
Const ppShowTypeSpeaker = 1
' Undocument constant used to display show in a window
' without PowerPoint command bars.
Const ppShowTypeInWindow = 1000


Public oPPTApp As Object
Public oPPTPres As Object

' API's used:
' To locate the handle of the PowerPoint slideshow window

Private Declare Function FindWindow Lib "user32" _
        Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As Long) As Long
' To set fram control as the parent of the slide show window
Private Declare Function SetParent Lib "user32" _
        (ByVal hWndChild As Long, _
        ByVal hWndNewParent As Long) As Long
' To set the caption of the window
Private Declare Function SetWindowText Lib "user32" _
        Alias "SetWindowTextA" (ByVal hwnd As Long, _
        ByVal lpString As String) As Long


Private Sub cmdShow_Click()
    Dim screenClasshWnd As Long, hwndPpt As Long, lngRet As Long
    On Error Resume Next
    Set oPPTApp = CreateObject("PowerPoint.Application")
    hwndPpt = FindWindow("Pp10FrameClass", vbNullString)
    lngRet = SetParent(hwndPpt, Me.frmSS.hwnd)
    If Not oPPTApp Is Nothing Then
        Set oPPTPres = oPPTApp.Presentations.Open(SHOW_FILE, , , False)
        If Not oPPTPres Is Nothing Then
            Set oPPTApp = CreateObject("PowerPoint.Application")
            hwndPpt = FindWindow("Pp10FrameClass", vbNullString)
            With oPPTPres
                With .SlideShowSettings
                    .ShowType = ppShowTypeSpeaker
                    With .Run
                        .Left = frmSS.Left + Me.Left
                        .Top = frmSS.Top + Me.Top + 5
                        .Width = frmSS.Width
                        .Height = frmSS.Height
                    End With
                End With
                screenClasshWnd = FindWindow("screenClass", vbNullString)
                lngRet = SetParent(screenClasshWnd, frmSS.hwnd)
            End With
        Else
            MsgBox "Could not open the presentation.", vbCritical, APP_NAME
        End If
    Else
        MsgBox "Could not instantiate PowerPoint.", vbCritical, APP_NAME
    End If
End Sub

Private Sub UserForm_Initialize()
    With Me
        .Caption = APP_NAME
    End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    'lblMessage.Visible = True
    DoEvents
    If Not oPPTPres Is Nothing Then
        oPPTPres.Close
    End If
    Set oPPTPres = Nothing
    If Not oPPTApp Is Nothing Then
        oPPTApp.Quit
    End If
    Set oPPTApp = Nothing
    'lblMessage.Visible = False

End Sub

Thanks!

BD

 

[mintjulep]

Did you bother to read the copyright notice in the code you posted?

 

[bdmangum]

I pulled the code directly off the web. I can post the link to the website. I don't think reposting with some of my modifications violates the copyright. Not to mention I have seen similar code written by other people while browsing the web. I posted the copyright with the code so the original designer can receive his due credit, even though I have added in my own modifications.

 

[bdmangum]

Just for clarification. Here is the website from which I got the code:

http://skp.mvps.org/vb/pptvbwnd.htm