Das führt zum gleichen Ergebnis. Die Selection geht ja über vielerlei Wege und ist auch immer korrekt, allerdings arbeitet Exportasfixedformat die Selections wahrscheinlich nacheinander ab und springt dann immer auf die nächste Seite für jede Spalte.
Ich habe es jetzt über eine temp-sheet gelöst. Anbei der Code; auch etwas mehr aufgeräumt.
Eine kurze Frage, wie unselektiere ich im SourceSheet die Spalten? Nach dem Ausführen des Makros sind die benötigten Spalten noch selektiert. Ist zwar kein Problem aber würde schöner aussehen wenn da nichts selektiert wärer oder der Cursor in A1 steht.
Sub Export_and_Print_1()
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 strPathFile As String
Dim strTmpsheet As String
Dim strSource As String
Dim strSourceRange As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'----- set source & temp sheet-----
strSource = "Tabelle1"
strSourceRange = "A:A,D:D,F:F,G:G,H:H,J:J"
strTmpsheet = "temp-to-print.ttp"
strTime = Format(Now(), "yyyymmdd\_hhmmss")
'----- get active workbook folder, if saved -----
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'----- replace spaces and periods in sheet name -----
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'----- create default name for saving file -----
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'----- select folder & let user customize file name -----
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Bitte wählen Sie den Speicherort.")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'---- add temp sheet and setting up the paper -----
ThisWorkbook.Sheets.Add.Name = strTmpsheet
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
End With
'----- going to source and getting the data -----
Sheets(strSource).Select
If myFile <> "False" Then
Range(strSourceRange).Select
Selection.Copy
Sheets(strTmpsheet).Select
ActiveSheet.Paste
'----- make the PDF -----
Sheets(strTmpsheet).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'----- confirmation message with file info -----
MsgBox "PDF wurde erfolgreich erstellt: " _
& vbCrLf _
& myFile
ThisWorkbook.Sheets(strTmpsheet).Delete
End If
'----- exit handler -----
exitHandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
errHandler:
MsgBox "PDF konnte nicht erstellt werden!"
Resume exitHandler
End Sub
|