|
' ------------------------------------------------------------------------
' 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:\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
|