VBA to capture an image of an excel userform with option of saving or attaching to an email

Question

I have been attempting to undertake what I hope has been made clear by the title of this question.

I have attempted what is show here in a previous question but I was stumped by the fact that I am running a 64bit machine which i then tried to remedy using another previous question.

Any thoughts would be greatly appreciated.

Answer 1

I just wanted to post how I eventually solved the userform screenshot component of the above question. I wrote this over a year ago so I apologise if it is hard to follow. I have cleaned it up. Any questions holler at me.

'Declares variables for userform screen shot
Option Explicit
Public Const VK_SNAPSHOT = 44
Public Const VK_LMENU = 164
Public Const KEYEVENTF_KEYUP = 2
Public Const KEYEVENTF_EXTENDEDKEY = 1

Private Sub CommandButton10_Click()
'Check File
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim cnf
Dim cnf2
Dim dir1 As String
Dim dir12 As String
Set cnf = CreateObject("Scripting.FileSystemObject")
Set cnf2 = CreateObject("Scripting.FileSystemObject")
dir1 = RELEVANT DIRECTORY & Me.parcelBox.Value 'user defined field
dir12 = RELEVANT DIRECTORY & Me.parcelBox.Value & "\" & Me.ComboBox1.Value & "\" 'user defined fields

If Not cnf.FolderExists(dir1) Then
    cnf.CreateFolder (dir1)
If Not cnf2.FolderExists(dir12) Then
    cnf2.CreateFolder (dir12)

End If
End If
myPath = dir12


'Screenshot Userform2
''''''''''''''''

'checks if excel version as this will not work for <=2003
If Application.Version < 12 Then
    MsgBox ("Your Are Using Excel 2003. Unfortunately You Are Unable To Save A Form. Email A Section Lead A Brief Description Of The Complaint")
    GoTo outdated
End If

'prompts whether user wants a pdf the userform or not
intMessage1 = MsgBox("Create PDF of Form", _
    vbYesNo, "Closing")
If intMessage1 = vbYes Then
    GoTo saveform
    End
Else
    GoTo donotsaveform
End If

saveform:
Application.Wait Now + TimeValue("00:00:02")

'directory path to save screenshot
myPath = dir12

DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

ActiveSheet.Range("A1").Select    

ActiveSheet.PageSetup.Orientation = xlLandscape

'Full path with pdf file name based on userinput in combobox
newpath1 = myPath & "\" & Me.ComboBox3.Value & ".pdf" 'user defined field


  'checks if file already exists
If dir(newpath1) = "" Then
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            myPath & Me.ComboBox3.Value & ".pdf", Quality _
            :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    ActiveWorkbook.Close False

Else
    Dim mypath4 As String
    Dim mypath5 As String
    mypath4 = Application.GetSaveAsFilename(InitialFileName:=myPath,    FileFilter:="PDF Files (*.pdf), *.pdf")

    If mypath4 = "False" Then
        ActiveWorkbook.Close False
        GoTo cancel1
    Else

        mypath5 = mypath4

        'overwrites if it does exist
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            mypath5, Quality _
            :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
            ActiveWorkbook.Close False
    End If
End If
donotsaveform:
cancel1:

outdated:

Me.Hide
UserForm3.Show

End Sub