Sub Export_and_Print_1()
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
End With
Application.PrintCommunication = True
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strSelection As Range
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Bitte wählen Sie den Speicherort.")
If myFile <> "False" Then
wsA.Select
Set strSelection = wsA.Range("A:A,B:B")
strSelection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
MsgBox "PDF wurde erfolgreich erstellt: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "PDF konnte nicht erstellt werden!"
Resume exitHandler
End Sub