Speicherungsfehler

Hallo Profis,
brauche wieder einmal eure Hilfe bei dem folgenden Problem.
Ich habe eine Datei bei der nach dem Speichern automatisch eine neue Excel-Datei und eine PDF-Datei angelegt wird. Die Verzeichnisse werden vor der Speicherung ggf. auch angelegt.
Einzeln ausgeführt klappen die Sub Codes auch soweit. In Verbindung mit dem übergeordneten i>"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)"
Code stü _ _ rzt Excel jedoch ab. Grund scheint der Sub Code Eintrag >"ThisWorkbook.SaveAs strPath & _ Range("A1"), xlOpenXMLWorkbookMacroEnabled" zu sein. Nach dem ersten Programmdurchlauf möchte VB noch einen Programmdurchlauf machen und stürzt dann _ _ ab. Code unter DieseArbeitsmappe


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Speichern_und_Export
End Sub

Modul
Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
Sub Speichern_und_Export()
Dim strPath As String
Dim strPathPDF As String
On Error Resume Next
'Makro Speichern
strPath = "C:\Users\[USERNAME]\Desktop\Excel Test\" & _
Format(Date, "yyyy") & "\" & Format(Date, "mm.yyyy") & "\"
MakePath (strPath)
ThisWorkbook.SaveAs strPath & Range("A1"), xlOpenXMLWorkbookMacroEnabled

'Makro Export
strPathPDF = "C:\Users\[USERNAME]\Desktop\Excel Test\" & _
Format(Date, "yyyy") & "\" & Format(Date, "mm.yyyy") & "\PDF\"
MakePath (strPathPDF)
Sheets(Array("Test1-1", "Test1-3")).Select
Sheets("Test1-1").Activate
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathPDF & "\" & Range("F5").Value & Range("A1") & " " & _
Format(Now, "dd_mm_yyyy") & " " & Format(Time, "hh-mm-ss") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Wie muss ich den Code umstellen, damit er funktioniert?
Danke im Voraus
Dirk

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Declare Function MakePath Lib "imagehlp.dll" Alias _ "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long Sub Speichern_und_Export() Dim strPath As String Dim strPathPDF As String On Error Resume Next 'Makro Speichern strPath = "C:\Users\[USERNAME]\Desktop\Excel Test\" & _ Format(Date, "yyyy") & "\" & Format(Date, "mm.yyyy") & "\" MakePath (strPath) On Error GoTo Fehler Application.EnableEvents = False ThisWorkbook.SaveAs strPath & Range("A1"), xlOpenXMLWorkbookMacroEnabled Application.EnableEvents = True On Error Resume Next 'Makro Export strPathPDF = "C:\Users\[USERNAME]\Desktop\Excel Test\" & _ Format(Date, "yyyy") & "\" & Format(Date, "mm.yyyy") & "\PDF\" MakePath (strPathPDF) Sheets(Array("Test1-1", "Test1-3")).Select Sheets("Test1-1").Activate ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=strPathPDF & "\" & Range("F5").Value & Range("A1") & " " & _ Format(Now, "dd_mm_yyyy") & " " & Format(Time, "hh-mm-ss") & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False Fehler: If Err.Number 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread