PDA

View Full Version : Save to PDF



austenr
11-16-2017, 03:57 PM
Trying to get the following to save as a PDF.


Private Sub btnPrintPDF_Click()


ChDir "c:\Temp"
Dim X

X = Application.GetSaveAsFilename(InitialFileName:="MorningReport.pdf", _
FileFilter:="PDF files, *.pdf", _
Title:="Save PDF File")
If TypeName(X) = "Boolean" Then
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=X, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If


'WindowToPDF ThisWorkbook.Path & "\.pdf"
End Sub

Want to save WindowToPDF with the application.getsaveasfilename

Cant figure out where to put the function?

Kenneth Hobs
11-16-2017, 04:26 PM
Looks ok. Some years back I made a function to show that dialog or not. e.g.

Sub Test_PublishToPDF() Dim s As String, ss As String
s = Range("F5").Value2 & Range("F4").Value2 & ".pdf"
'ss= PublishToPDF(s, ActiveSheet) 'Use set print range

Dim r As Range
Set r = Columns("A:A").Find("TOTAL LIABILITIES & EQUITY")
If r Is Nothing Then Exit Sub
ss = PublishToPDF(s, Range("A1:B" & r.Row)) 'Use a dynamic range
'ss = PublishToPDF(s, Range("A1:B" & r.Row), True) 'Use a dynamic range, prompt for filename
Shell "cmd /c " & ss, vbNormalFocus
End Sub


Function PublishToPDF(fName As String, o As Object, _
Optional tfGetFilename As Boolean = False) As String
Dim rc As Variant
rc = fName
If tfGetFilename Then
rc = Application.GetSaveAsFilename(fName, "PDF (*.pdf), *.pdf", 1, "Publish to PDF")
If rc = "" Then Exit Function
End If

o.ExportAsFixedFormat Type:=xlTypePDF, fileName:=rc _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

PublishToPDF = rc
End Function

austenr
11-16-2017, 07:22 PM
so my OP Had a commented out line. This is to save Userform1 using that function. Can you show how to do that? If you take out the code above the commented out line it works fine and saves the form to the same root folder the workbook is in. I simply just want to let the user save it where they want it.

Kenneth Hobs
11-16-2017, 07:59 PM
I am feeling dejay vu...

For those that don't know, below is the WindowToPDF() routine.

So, it could be:

WindowToPDF Application.GetSaveAsFilename
Of course you can add more bells and whistles. e.g. Make sure that the file extension they enter is pdf in a call to GetSaveAsFileName before WindowToPDF().



'Similar to jaslake,https://www.excelforum.com/excel-programming-vba-macros/1202015-print-userform-to-pdf-and-then-attach-it-to-an-email.html'and
'Similar to, https://www.ozgrid.com/forum/forum/help-forums/excel-general/100863-sending-userform-as-pdf
#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
11-17-2017, 08:27 AM
Hi Ken. I tried this


WindowToPDF Application.GetSaveAsFilename

and the only option it gives is "All files"

Switching it to this:


Application.GetSaveAsFilename WindowToPDF()

throws an error of "Compile error: Agrument not optional"

austenr
11-17-2017, 08:58 AM
I got this to work but the dialogue box shows up in the image as well


WindowToPDF Application.GetSaveAsFilename( _
fileFilter:="PDF Files (*.pdf), *.pdf")

Aflatoon
11-17-2017, 09:14 AM
How about:


Private Sub btnPrintPDF_Click()

ChDir "c:\Temp"
Dim X

X = Application.GetSaveAsFilename(InitialFileName:="MorningReport.pdf", _
FileFilter:="PDF files, *.pdf", _
Title:="Save PDF File")
If TypeName(X) <> "Boolean" Then WindowToPDF X

End Sub