VBA to screenshot a userform

[tygrrboi]

I do not know if this is possible... but I would like to essentially take a screen shot of an entire userform and then paste that image onto the sheet using VBA.
(this will be done several times, with the location of the image - topleftcell incrementing with each screen shot. The userform data will also be populated automatically so there is no need to worry about any wait timers for the user to change the information.)

I do not mind if the temporary image needs to be stored in a directory... I am not sure how these things even work. Any help would be greatly appreciated.

 

[pbornemeier]

Option Explicit

'Most of code below taken from:
'http://www.mrexcel.com/forum/excel-questions/348354-userform-image-copy-worksheet-cell.html

Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal _
    bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_KEYUP = &H2
Const VK_SNAPSHOT = &H2C
Const VK_MENU = &H12

Sub CopyUserFormToWorksheet()

    'Must be called by code that is executing while userform1 is showing
    
    Dim lPrintCol As Long
    Dim lPrintRow As Long

    'Arbitrary cells picked to store next print location
    If Range("Y1").Value = 0 Then Range("Y1").Value = 26    'Column of next image
    If Range("Z1").Value = 0 Then Range("Z1").Value = 4     'Row of next image
    
    UserForm1.Copy  'Ensures userform is active item (if Excel (not VBA Editor) is active
    
    Print_Active Range("Z1").Value, Range("Y1").Value
    
    Range("Y1").Value = Range("Y1").Value + 1
    Range("Z1").Value = Range("Z1").Value + 1
    
End Sub

'=====================================================================
'- SUBROUTINE : PRINT SCREEN & PASTE INTO THE WORKSHEET
'- events and SendKeys work slowly, so need lots of delays in the code
'- ALT+PrtScrn copies active window
'- PrtScrn copies the entire desktop
'=====================================================================
Private Sub Print_Active(lRow As Long, lCol As Long)
    '- API print screen
    keybd_event VK_MENU, 0, 0, 0        ' Alt key down
    DoEvents
    keybd_event VK_SNAPSHOT, 0, 0, 0    ' PrintScreen key down
    DoEvents
    keybd_event VK_SNAPSHOT, 0, VK_KEYUP, 0
    DoEvents
    keybd_event VK_MENU, 0, VK_KEYUP, 0
    DoEvents
    '---------------------------------------------------------------
    '- paste picture to worksheet
    ActiveSheet.Paste Destination:=ActiveSheet.Cells(lRow, lCol)
    DoEvents
    Application.Wait Now + TimeValue("00:00:01")    ' WAIT 1 SECOND
End Sub
'=====================================================================