Save to PDF

[austenr]

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]

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]

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]

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]

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]

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]

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