I need a macro code which lets me save a Pdf file of selected area..

[akinkaraman]

I have a code but I need it to save just for the selected area after asking the pdf name and if it will be vertical or horizantal..

Thanks..

Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName

If FSO.FileExists(s(0)) Then
'//Change Excel Extension to PDF extension in FilePath
s(1) = FSO.GetExtensionName(s(0))
If s(1) <> "" Then
s(1) = "." & s(1)
sNewFilePath = Replace(s(0), s(1), ".pdf")

'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNewFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If

Set FSO = Nothing

End Sub

 

[Gangadhar Yeligaty]

Hi,
Please use below code to save Selected Area

Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName

If FSO.FileExists(s(0)) Then
'//Change Excel Extension to PDF extension in FilePath
s(1) = FSO.GetExtensionName(s(0))
If s(1) <> "" Then
s(1) = "." & s(1)
sNewFilePath = Replace(s(0), s(1), ".pdf")

'// copy selected area and save it in new sheet
  Selection.Copy
  Sheets.Add
  ActiveSheet.Paste
  Application.CutCopyMode = False
 
'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNewFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

'// Delete the temp sheet after saving PDF
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

End If
Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If

Set FSO = Nothing

End Sub

 

[akinkaraman]

Hi it works good. Can we make it to fit in 1 page?

This always save in same File name and if I try to save second one it saves on the old one. It doesn't ask the pdf file name.. And it doesn't ask where to save. It is now defaultly saving into desktop.

 

[Gangadhar Yeligaty]

Hi,

Here is the code with page setup and popup to ask file name & path.

Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String

Dim intChoice As Integer
Dim strPath As String

Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName

'//make the file dialog visible
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show

If intChoice <> 0 Then
  '//get the file path
  strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)

If FSO.FileExists(s(0)) Then

'// copy selected area and save it in new sheet
  Selection.Copy
  Sheets.Add
  ActiveSheet.Paste
  Application.CutCopyMode = False

'//page setup >> fitTo single page
  Cells.Select
  Cells.EntireColumn.AutoFit
  Application.PrintCommunication = False
  With ActiveSheet.PageSetup
  .FitToPagesWide = 1
  .FitToPagesTall = 1
  End With
  Application.PrintCommunication = True
 
'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

'// Delete the temp sheet after saving PDF
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If
Else
MsgBox "You have stoped the process...!!"
End If

Set FSO = Nothing

End Sub

I hope this solves your problem.

 

[akinkaraman]

Fit to screen (in 1 Page) is not success here..

 

[akinkaraman]

I think it doesn't fit good because of not asking if vertical or horizantal.
It always tries to save as horizontally.

 

[akinkaraman]

Hello Mr. Yeligaty

I think you changed your codes.. Your first code is not working anymore. Second code has still problem with marge.

 

[akinkaraman]

Any solution?