Display PowerPoint slide show within a VB form or control window

The example below shows how to use VB form/control as a container application to display a PowerPoint slideshow. It as shows how to make use of an undocumented slide show setting to run the slideshow in a window of it's own without any PowerPoint toolbars.

System requirements:

  • Visual Basic 6.0 to compile the code

  • PowerPoint installed on the target system

Click here to download the VB project

 

 

 
     
 
' ------------------------------------------------------------------------
' Copyright ©1999-2011, 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:\PowerPoint\Sample.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(Index As Integer)
    Dim screenClasshWnd As Long
    On Error Resume Next
    Set oPPTApp = CreateObject("PowerPoint.Application")
    If Not oPPTApp Is Nothing Then
        Set oPPTPres = oPPTApp.Presentations.Open(SHOW_FILE, , , False)
        If Not oPPTPres Is Nothing Then
            With oPPTPres
                Select Case Index
                Case Is = 0
                    With .SlideShowSettings
                        .ShowType = ppShowTypeSpeaker
                        With .Run
                            .Width = frmSS.Width
                            .Height = frmSS.Height
                        End With
                    End With
                    screenClasshWnd = FindWindow("screenClass", 0&)
                    SetParent screenClasshWnd, frmSS.hwnd
                    With Me
                        .Height = 4545
                        .SetFocus
                    End With
                Case Is = 1
                    With .SlideShowSettings
                        .ShowType = ppShowTypeInWindow 
                        .Run
                    End With
                    Call SetWindowText(FindWindow("screenClass", 0&), APP_NAME)
                End Select
            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 Form_Initialize()
    With Me
        .ScaleMode = vbPoints
        .Caption = APP_NAME
    End With
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode 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

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

posted @ 2014-06-24 15:53  seasonzone  阅读(492)  评论(0)  编辑  收藏  举报