When there was no unhidden workbook open and the ActiveSheet was a chart sheet, the error Run-time error '91': Object variable or With block variable not set occurred.
When the folder didn't exist, different issues occurred (Run-time error '1004': Document not saved. It's possible that the document is open, or that an issue occurred during the saving process.) if the selection was not a range (Run-time error '438': This property or method is not supported by this object).
Option Explicit
Sub ExportSelectionToPDF()
Const ProcName As String = "ExportSelectionToPDF"
On Error GoTo ClearError
Const dFolderPath As String = "H:\data\Desktop\"
Const dFileExtension As String = ".pdf"
If Len(Dir(dFolderPath, vbDirectory)) = 0 Then
MsgBox "The path '" & dFolderPath & "' doesn't exist.", _
vbCritical, ProcName
Exit Sub
End If
Dim sh As Object: Set sh = ActiveSheet
If sh Is Nothing Then ' to test, close all workbooks
MsgBox "No active sheet ('Nothing').", vbCritical, ProcName
Exit Sub
End If
If sh.Type <> xlWorksheet Then ' to test, activate a chart sheet
MsgBox "No worksheet ('" & sh.Name & "') active.", vbCritical, ProcName
Exit Sub
End If
If TypeName(Selection) <> "Range" Then ' to test, select a shape
MsgBox "No range ('" & TypeName(Selection) & "') selected.", _
vbCritical, ProcName
Exit Sub
End If
Dim paAddress As String: paAddress = Selection.Address
Dim BaseName As String: BaseName = sh.Parent.Name
If InStr(BaseName, ".") > 0 Then
BaseName = Left(BaseName, InStrRev(BaseName, ".") - 1)
End If
Dim dFilePath As String: dFilePath = dFolderPath & BaseName & dFileExtension
With sh.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'.Orientation = xlLandscape
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintArea = paAddress
End With
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub