Print userform to PDF

[austenr]

Ive got the following code tied toa button to print an open user form and its contents to a PDF. It errors out. Can anyone tell me whats wrong?


Private Sub btnPrintPDF_Click()Dim Msg As String

On Error GoTo MakePDFError:
Application.ActivePrinter = "Adobe PDF Printer:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"Adobe PDF Printer:", collate:=True

Exit Sub

MakePDFError:
Msg = "PDF could not be created. Click File: Print to create."

MsgBox Msg, vbCritical, "Make PDF"

End Sub

[Kenneth Hobs]

You already put the image into the selected sheet?

I would use API's to make a BMP file. I have copied the image using API's to a sheet and then exported it as a PDF.

If you want a dialog to set the filename, then set the ActivePrinter to one that prints PDF's and then use Me.PrintForm.

[austenr]

Can you post an example of what you mean?

[Kenneth Hobs]

http://www.vbaexpress.com/forum/showthread.php?24016-Setting-Application-ActivePrinter-and-PrintForm

[austenr]

ok trying to save the form as PDF. Getting an error on this line:


sPath = ThisWorkbook.Path & "\" & UserForm1

entire code


Private Sub btnPrintPDF_Click()Dim sPath As String, sFile As Variant
Dim ws As Worksheet


On Error GoTo ErrHandler


sPath = ThisWorkbook.Path & "\" & UserForm1


sFile = Application.GetSaveAsFilename _
(InitialFileName:=sPath, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and File Name to Save")

If sFile = "False" Then
MsgBox ("Please Choose a File Name")
Exit Sub

UserForm1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Exit Sub

ErrHandler:
MsgBox ("Document Not Saved")




End Sub

[Kenneth Hobs]

The error is because Userform1 is an object, not a string.

Forms have no ExportAsFixedFormat method.

Two API methods are shown at: https://www.excelforum.com/excel-programming-vba-macros/1202015-print-userform-to-pdf-and-then-attach-it-to-an-email.html

I have attached a file with my API method as shown in that thread.

[austenr]

Hi ken thanks for that. im on a 64 bit and this is for 32 bit. what needs to be modified?

[Kenneth Hobs]

Just try and see.

For 64bit, you will need the PtrSafe in the API's. API's start at the top of a Module. I use Win10 but 32bit Excel so those in the file work for me.

There are 64bit API's that can be used. JKP shows several and how to do both. http://www.jkp-ads.com/articles/apideclarations.asp
Though for Office 2010, most should be here too: https://support.microsoft.com/en-us/help/2030490/office-2010-help-files-win32api-ptrsafe-with-64-bit-support

[austenr]

not sure what the PrtSafe is but when running this i get the following error:

the code in this project must be updated for use on 64 bit systems. Review and update the Declare Statements and mark them with the PrtSafe attribute.

Ive got no clue what to do.

[Kenneth Hobs]

JKP shows how to do one API for both:

#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If

So, if code had the GetDeviceCaps without PtrSafe, you would look for that name with PtrSafe from the JKP or Microsoft link that I supplied. Maybe tonight I can do it for you.

[austenr]

thanks that would be appreciated.

[Kenneth Hobs]

The clipboard to BMP API's used in userform1 has a problem. It has a DLL entry point error for the SetClipboardData. Since routines need to return LongPtr type, there is no point in using the VBA7 test. I attached the file in case someone has time to debug it. If you do test it and it errors, simply close Excel and reopen to fix the clipboard memory overload.

For me, the API sendkeys method seems to "work". I made it into a Function for you. Put this into a new Module. No check was made to see if the drive and path for the pdf filename is valid/exists.

'Similar to jaslake,https://www.excelforum.com/excel-programming-vba-macros/1202015-print-userform-to-pdf-and-then-attach-it-to-an-email.html
#If VBA7 Then
Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If


Private Const VK_SNAPSHOT = 44
Private Const VK_LMENU = 164
Private Const KEYEVENTF_KEYUP = 2
Private Const KEYEVENTF_EXTENDEDKEY = 1


Function WindowToPDF(pdf$, Optional Orientation As Integer = xlLandscape, _
Optional FitToPagesWide As Integer = 1) As Boolean
Dim calc As Integer, ws As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

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
Set ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
With ws
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Select
.PageSetup.Orientation = Orientation
.PageSetup.FitToPagesWide = FitToPagesWide
.PageSetup.Zoom = False
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
.Parent.Close False
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
.CutCopyMode = False
End With

WindowToPDF = Dir(pdf) <> ""
End Function

[austenr]

Hi Ken,

I found this post by you.

https://www.ozgrid.com/forum/forum/help-forums/excel-general/100863-sending-userform-as-pdf

would this work? I tried it on a utton but all it does is ask if i want to clear the clipboard I think.

[Kenneth Hobs]

Did you try my last post and it not work? I corrected a couple of things.

It has been so long, I forgot about that one at ozgrid. Luckily, I am a little smarter now. My post #12 uses that same method for use in userform2.

Just try the last attachment. It is very easy to use that function. I tend to code in modular ways to make it easy to reuse code and help others.

[austenr]

Hi Ken,

Im going to upload my Workbook at this point. I tried your WB again and got an error in this sub:


Option Explicit

'http://www.vbaexpress.com/forum/showthread.php?24016-Setting-Application-ActivePrinter-and-PrintForm
Private Type PRINTER_INFO_4
pPrinterName As Long
pServerName As Long
Attributes As Long
End Type

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
Private Const PRINTER_LEVEL4 = &H4
Private Const PRINTER_ENUM_LOCAL = &H2

Private Declare Function SendNotifyMessage Lib "user32" Alias "SendNotifyMessageA" ( _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function SetDefaultPrinter Lib "winspool.drv" _
Alias "SetDefaultPrinterA" (ByVal pszPrinter As String) As Long

Public Sub ChangePrinter(NewPrinter As String)
SetDefaultPrinter NewPrinter
'broadcast the change
Call SendNotifyMessage(HWND_BROADCAST, _
WM_WININICHANGE, 0, ByVal "windows")
End Sub


Public Sub Test_UserForm_PrintForm()
Dim OldPrinter As String
OldPrinter = Left$(Application.ActivePrinter, InStrRev(Application.ActivePrinter, "on ") - 2)
ChangePrinter "PDFCreator" '"HP LaserJet 8000 Series PCL"

UserForm1.PrintForm 'change UserForm1 to suit.






ChangePrinter OldPrinter
End Sub


says it needs to be updated to 64 but. I changed Lib "user32" to Lib "user64" but that didnt seem to help.

[austenr]

I got this to compile clean finally. On the button click event in the user form what code goes there. also where is userform1 called in the function?


Option Explicit

#If VBA7 Then
Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#End If


Private Const VK_SNAPSHOT = 44
Private Const VK_LMENU = 164
Private Const KEYEVENTF_KEYUP = 2
Private Const KEYEVENTF_EXTENDEDKEY = 1


Function WindowToPDF(pdf$, Optional Orientation As Integer = xlLandscape, _
Optional FitToPagesWide As Integer = 1) As Boolean
Dim calc As Integer, ws As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

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
Set ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
With ws
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Select
.PageSetup.Orientation = Orientation
.PageSetup.FitToPagesWide = FitToPagesWide
.PageSetup.Zoom = False
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
.Parent.Close False
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
.CutCopyMode = False
End With

WindowToPDF = Dir(pdf) <> ""
End Function

[Kenneth Hobs]

Right, that is the code from post #12. Using it is basically it and one word, the pdf file to make.

It is used in userform2.


Private Sub MakeAndExit_Click()
WindowToPDF TextBox1.Value
'Show created PDF file.
Shell "cmd /c " & """" & TextBox1.Value & """", vbNormal
Unload Me
End Sub

[austenr]

heres my updated module.



Option Explicit


#If VBA7 Then
Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#End If


Private Const VK_SNAPSHOT = 44
Private Const VK_LMENU = 164
Private Const KEYEVENTF_KEYUP = 2
Private Const KEYEVENTF_EXTENDEDKEY = 1


Function WindowToPDF(pdf$, Optional Orientation As Integer = xlLandscape, _
Optional FitToPagesWide As Integer = 1) As Boolean
Dim calc As Integer, ws As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

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
Set ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
With ws
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Select
.PageSetup.Orientation = Orientation
.PageSetup.FitToPagesWide = FitToPagesWide
.PageSetup.Zoom = False
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
.Parent.Close False
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calc
.CutCopyMode = False
End With

WindowToPDF = Dir(pdf) <> ""
End Function


Private Sub MakePDF()
WindowToPDF UserForm1.btnPrintPDF



End Sub


now when i run the form i get a pop up box asking what macro to run.

here is my form button click event



Private Sub btnPrintPDF_Click()
MakePDF
End Sub

[Kenneth Hobs]

If you would attach your file, I can see what is going on.

The only reason to use Userform1 is if MakePDF is not in Userform1 and Userform1 is open or loaded.

So, does

Debug.Print UserForm1.btnPrintPDFreturn a valid drive:\path\filename.pdf? Press Ctrl+G after a run to view the Immediate Window's results. I don't see how a btnPrintPDF could have a Value = to a pdf filename as it has no Value property. One could use Tag or Caption I guess. Tag would be the better property.

As I showed in the workbook and my last post, I used TextBox1 to store the pdf filename. It initially filled the value for the user. Of course there are more advanced ways to let the user pick a filename to use. The purpose was to show how the Function was used. The function could be used for any ActiveWindow.

[austenr]

heres my WB

[Kenneth Hobs]

You didn't include my function. The more important thing is that you did not provide a drive:\path\filename.pdf for the file to create. Are you going to create a static filename like I did or is it built from parts of your userform control Values?

The userform was too big to fully display and show the buttons for me. That may be a factor for you if others have screen settings lower than yours.

e.g. Static Name:

Private Sub btnPrintPDF_Click()
WindowToPDF ThisWorkbook.Path & "\Staples.pdf"
End Sub

[austenr]

perfect!!! thanks for hanging in there with me on this. much appreciated. Solved.

[bkeller83]

I'm just here to say THANK YOU! I needed to perform this exact operation and was able to successfully use the code supplied. :thumb