sporadischer Fehler beim PDF Druck (1004)
18.06.2017 15:32:19
Andi
Ich drucke mit dem PDF Acrobat.
A B E R
Der Fehler tritt nicht auf, wenn vor dem ausführen des Makros in der zu speichernden Tabelle1 eine Zelle markiert wird- zum Beispiel mit Doppelklick auf C12.
Dann kommt der Fortschritt-Balken- Veröffentlichung -Fertig
Ist da vielleicht noch etwas im Speicher- sollte vielleicht die Tabelle1 vor dem ausführen erst mal geschlossen und wieder geöffnet werden- oder könnte man die Tabelle1 vorher "aktiv" setzen?
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
Dim strDir As String
Dim wkb As Workbook, wkbCopy As Workbook, bolSpeichern As Boolean
On Error GoTo Fin
Sheets("Tabelle1").Select
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Dokumente\", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
strDir = Left(varPath, InStrRev(varPath, "\"))
Set wkb = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
If Dir(varPath) "" Then
Select Case MsgBox("Datei überschreiben?", 4 + 32 + 0, "Datei")
Case vbYes
bolSpeichern = True
Case Else
GoTo Fin
End Select
Else
bolSpeichern = True
End If
If bolSpeichern = True Then
wkb.Sheets("Tabelle1").Copy
Set wkbCopy = ActiveWorkbook
With wkbCopy
wkb.Sheets("Deckblatt").Copy After:=.Sheets(1)
wkb.Sheets("Bearbeiten").Copy After:=.Sheets(2)
.SaveAs varPath, 51
.Close False
End With
Set wkbCopy = Nothing
With wkb
.Worksheets("Tabelle1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Tabelle1 " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Worksheets("Deckblatt").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
End With
Set wkb = Nothing
End If
Else
MsgBox "Abgebrochen..."
End If
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description
End Sub
LG Andi