I want to save a range of page in excel woksheet (e.g. page 2 to 9 and 14 to 21) as pdf. the following VBA i am using is saving the whole page as pdf.
the pdf is saved in the same folder where the excel is save, i need to save this pdf in a sub folder (a new folder will be allocated where the excel is present).
Sub PDFActiveSheetNoPromptCheck()
'checks for existing file
'prompt to overwrite or rename
'uses bFileExists Function, below
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("d5").Value _
& "-" & wsA.Range("b25").Value _
& "-" & wsA.Range("d6").Value
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If
'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
Help me out in this case. thanx in advance.
the pdf is saved in the same folder where the excel is save, i need to save this pdf in a sub folder (a new folder will be allocated where the excel is present).
Sub PDFActiveSheetNoPromptCheck()
'checks for existing file
'prompt to overwrite or rename
'uses bFileExists Function, below
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("d5").Value _
& "-" & wsA.Range("b25").Value _
& "-" & wsA.Range("d6").Value
'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
'user can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
strPathFile = myFile
Else
GoTo exitHandler
End If
End If
End If
'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
Help me out in this case. thanx in advance.