Create PPT

Question

Hi,
I have one excel sheet with 2 buttons. My goal is to take screenshot by pressing PrintScreen button and paste them into Powerpoint followed by clicking on button1. Means, if I click on button 1, it will add screenshots to powerpoint whenever user press PrintScreen
button until and unless the button2 is pressed. If I click on Button 2 it will prompt for a path to save newly created Powerpoint. I have one piece of code that will capture screenshot but it is not capable of handling PrintScreen button manually. 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const VK_SNAPSHOT As Byte = 44
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal _
nCmdShow As Long) As Long
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2
Private Sub CommandButton1_Click()
Dim IE As Object
Dim hwnd As Long, IECaption As String
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "www.Google.com"
Sleep 5000
IECaption = "Google - Windows Internet Explorer"
hwnd = FindWindow(vbNullString, IECaption)
If hwnd = 0 Then
MsgBox "IE Window Not found!"
Exit Sub
Else
ShowWindow hwnd, SW_SHOWMAXIMIZED
End If
DoEvents
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
newPowerPoint.Visible = True
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
activeSlide.Shapes.Paste
' Set myShapeRange = activeSlide.Shapes(activeSlide.Shapes.Count)
' myShapeRange.Left = 234
' myShapeRange.Top = 186
End Sub
Also, while the code paste a screenshot in Powerpoint, I want it to be in a size same as a slide's size. However currently it is going beyond the slide area.

Answer 1

Hi Edward,
Thanks for your reply. I don't have any problem with win32 level API. My requirement is like whenever user press printscreen button system should open one presentation and add the screenshot in each slide until user press End button. Once user press End
button it should not paste any more screenshot to the slide and save the powerpoint to a path  mentioned in the code. Please find below the code that I'm using. Please insert a button in excel sheet and paste the following code.
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public bEsc, bScr, Comment, step_count, Val, Path, ins_comments, show_alert
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Const MF_BYPOSITION = &H400&
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User" (ByVal hWnd As Integer) As Integer
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Sub CommandButton1_Click()
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
newPowerPoint.Visible = True
For j = 1 To 300
For i = 1 To 100000
If (GetAsyncKeyState(44)) Then
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
activeSlide.Shapes.Paste
End If
If (GetAsyncKeyState(35)) Then
strPpPath = "C:\Users\Jo\Desktop\Testing!!"
strPpName = strPpPath & "\" & "newPresentation1.pptx"
newPowerPoint.SaveAs Filename:=strPpName
Exit Sub
End If
Next i
Next j
End Sub
Now the following problems I have
1.Code is not able to save file in the given path. I'm getting "Method or Data Member Not Found Error".
2. If I wait for more than 15seconds to take a screenshot after pressing Commandbutton code is not working. I want after clicking commandbutton code should be activated and it should remain active until the user press End button. As per my current code system
stop taking screenshot after 15 seconds. 
3.If any powerpoint file open prior running the code, system is not able to create new powerpoint. Thus the code is getting failed.
Could you please help me modifying the code so that I can get the desired output.
Thanks..