Dual video Powerpoint and VB - help required

J

JohnK

Ok,
I have the code below and a form with two buttons. How can I change this to
show the PPT presentation on a secondary monitor. My system had a dual video
option an is settings are correct. PPT itself can play the show on the
second screen. But I'd like to do it by VB. I think I need some other
api-calls. Can someone help me? I'm a newbie in api.

TIA,
John

(code is an original from Shyam Pillai , MVPS.org)

Option Explicit
Const APP_NAME = "PowerPoint in VB window"

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

Public oPPTApp As Object
Public oPPTPres As Object



Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long,
ByVal hWndNewParent As Long) As Long
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("F:\Under
Development\PowerPoint\Dieyoung.ppt", , , 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 = 1000
.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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top