VBA - Userform - Command Button to Save Completed Userform in some format

[The Great SrH]

Hi all,

I've been searching everywhere for a bit of code to build into a Command Button on my Userform which will basically take a screenshot (or however best it will work) of the UserForm as it is at time of click, and then pop up with the Save As box for the end user to select save destination.

I don't care how bitty it is (ex. create a new worksheet, insert printscreen, save sheet as PDF/Picture, delete worksheet), I just need some sort of solution.

My preferable save format would be as a PDF, but I'll be happy for a decent resolution picture as an alternative (I just want the output to be the userform size, not a full screen print).


Any help will be greatly appreciated!

 

[Logit]

Hopefully this will do the job or at least get you started :

In a regular module :

Option Explicit


Sub shwfrm()
    UserForm1.Show
End Sub


Sub CommandButton1_Click()
Dim h1 As Object


    Set h1 = Sheets.Add
    h1.PageSetup.Orientation = xlLandscape
    Application.SendKeys "(%{1068})"
    DoEvents
    h1.Paste
    h1.PrintOut Copies:=1, Collate:=True
    Application.DisplayAlerts = False
    h1.Delete
End Sub

In the userform :

Option Explicit


'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 PtrSafe Sub keybd_event Lib "User32" _
'    (ByVal bVk As Byte, ByVal bScan As Byte, _
'     ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
     
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, ByVal bScan As Byte, _
         ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
       bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
     
    
    
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12 '''


Private Sub AltPrintScreen()
        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 Sub
Private Sub CommandButton1_Click()
Call AltPrintScreen
    DoEvents
    Application.Wait Now + TimeSerial(0, 0, 1)
    Worksheets("Sheet1").Range("B3").PasteSpecial
    Unload Me
End Sub

Download sample workbook : https://www.amazon.com/clouddrive/share/huTcs9gmWJ8Vsn0setM07nrPBZLRRZl0IJIMnDPTdxy

 

[DanteAmor]

How about

Change "userform" to the file name

Private Sub CommandButton1_Click()
    Dim h1 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets.Add
    Application.SendKeys "(%{1068})"
    DoEvents
    h1.Paste
    h1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "[COLOR=#0000ff]userform[/COLOR].pdf"
    h1.Delete
End Sub