screen capture slideshow from vba?

[Guest]

Hi All:
I confess I'm not much of a VBA programmer, so this could just be my
inexperience.
I'm trying to get an image of the screen when a PPT slideshow is running and
the user clicks on a command button.
This works fine when I manually press the <ALT> and <PrintScreen> keys, exit
the slideshow, and paste with <CTRL><V>
I tried using parts of the code in KB article #240653 with no luck.
Any suggestions greatly appreciated!
Thanks!
amb

 

[Steve Rindsberg]

Hi All:
I confess I'm not much of a VBA programmer, so this could just be my
inexperience.
I'm trying to get an image of the screen when a PPT slideshow is running and
the user clicks on a command button.
This works fine when I manually press the <ALT> and <PrintScreen> keys, exit
the slideshow, and paste with <CTRL><V>
I tried using parts of the code in KB article #240653 with no luck.
Any suggestions greatly appreciated!

Start by including the code exactly as you're using it and explaining more
specifically what "no luck" means. Blindfolded, it's hard to guess at the
problem. ;-)

 

[Guest]

Good Point Steve!
Actually, I got it working last night...I guess I just needed to bang my
head against it a little longer!
I created a presentation with two commands buttons and used the code pasted
below. Clicking on either places an image of the slide being displayed in
slideshow mode into the clipboard.
THANXS,
amb

code follows:
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Dim blnAboveVer4 As Boolean

Private Sub CommandButton1_Click()
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer

osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True

If blnAboveVer4 Then
keybd_event VK_SNAPSHOT, 0, 0, 0
Else
keybd_event VK_SNAPSHOT, 1, 0, 0
End If
End Sub

Private Sub CommandButton2_Click()
MsgBox "boo"
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True

If blnAboveVer4 Then
keybd_event VK_SNAPSHOT, 1, 0, 0
Else
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End If
End Sub