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/show...-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-pro...-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/...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/h...serform-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.btnPrintPDF

return 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