1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
|
Private Sub SavePCUPdf_Click()
On Error Resume Next
' Default full filename
DefPath = Sheets("DATA").Range("DefDir").Value
DefFile = Range("DocRef").Value
InitialFilename = DefPath & "\" & DefFile & ".pdf"
' Change current drive and path before opening dialog box
ChDrive DefPath
ChDir DefPath
On Error GoTo 0
' Open dialog box
FullFileName = Application.GetSaveAsFilename(InitialFilename, "PDF File (*.pdf), *.pdf")
'Generate & save pdf file
If FullFileName <> False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=FullFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End Sub |
Partager