Speicherungsfehler

Forumthread: Speicherungsfehler

Speicherungsfehler

18.04.2016 13:38:30

Dirk

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

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Speicherungsfehler

18.04.2016 14:36:02

UweD
AW: Speicherungsfehler

19.04.2016 09:22:12

Dirk
AW: Speicherungsfehler

19.04.2016 09:39:19

UweD

AW: Speicherungsfehler

18.04.2016 14:36:02

UweD

Hallo
Ich hab dein Makro selbst nicht getestet..
- Speichern löst immer das BevorSave Event aus
- aus dieser Routine rufst du wieder das Event auf, und wieder und wieder...
- dadurch tillt der Rechner dann
Cancel = True :
stoppt den ersten Aufruf
Application.EnableEvents = False:
unterbindet das erneute Aufrufen
muss aber wieder eingeschaltet werden
!! und ganz wichtig auch in einem Fehlerfall; deshalb die Fehlerzeile !!
Mein Frage ist , ob du On Error Resume Next wirklich benötigst,
oder ob im Fehlerfall ein Hinweis möglich wäre.


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


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

AW: Speicherungsfehler

19.04.2016 09:22:12

Dirk

Hallo Uwe,
danke für die Hilfe, jetzt klappts. On Error Resume Next habe ich nur eingefügt, damit er mir beim Programmtest nicht ständig eine Meldung anzeigt. Ich habs durch einen Fehlerhinweis ersetzt.
Danke noch einmal
Gruß
Dirk

AW: Speicherungsfehler

19.04.2016 09:39:19

UweD

Hallo nochmal
setze das "On Error GoTo Fehler" ganz nach oben
und lass alle anderen "On Error ..." komplett weg
Gruß UweD

Beliebteste Forumthreads (12 Monate)

Forumthread: Speicherungsfehler

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

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread