"speichern unter" Code klappt nicht 100%

Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Dateiname As String Dateiname = Format(Date, "yyyy_mm_dd") & "_KBW_" & Range("F20") & "_" & Range("F6") If ActiveSheet.Pictures.Count > 6 Then Application.Dialogs(xlDialogSaveAs).Show (Dateiname) Else MsgBox "Bitte alle geforderten Bilder einfügen!" End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Dateiname As String Dateiname = Format(Date, "yyyy_mm_dd") & "_KBW_" & Range("F20") & "_" & Range("F6") If ActiveSheet.Pictures.Count > 0 Then '> 6 Then Cancel = True Application.EnableEvents = False Application.Dialogs(xlDialogSaveAs).Show (Dateiname) Application.EnableEvents = True Else Cancel = True MsgBox "Bitte alle geforderten Bilder einfügen!" End If End Sub

Option Explicit Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) On Error GoTo Fehler Cancel = True ' abbrechen des aufgerufenen speicherns Dim Dateiname As String Dateiname = Format(Date, "yyyy_mm_dd") & "_KBW_" & Range("F20") & "_" & Range("F6") If ActiveSheet.Pictures.Count > 6 Then With Application .EnableEvents = False ' Druckschleife verhindern .Dialogs(xlDialogSaveAs).Show (Dateiname) End With Else MsgBox "Bitte alle geforderten Bilder einfügen!" End If '*** Fehlerbehandlung Err.Clear Fehler: Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Fehler: " & _ Err.Number & vbLf & Err.Description: Err.Clear End Sub

'Makro unter DieseArbeitsmappe Private Sub Workbook_BeforePrint(Cancel As Boolean) Select Case ActiveSheet.Name Case "Tabelle2", "Tab ABC" 'Diese Blätter ohne Prüfung drucken Case Else If ActiveSheet.Pictures.Count

Hallo Dennis,
die beiden Ereignismakros haben normalerweise nichts mit einander zu tun. Allerdings fehlte bei meinem Makro ein End Select.
Die Fehlermeldung zeigt eigentlich an, dass eine Datei mit dem Namen unter dem du deine Datei speichern möchtes bereits geöffnet ist. Dafür hab ich jetzt nochmals eine Prüfung eingebaut - inklusive einer Allgemeinen Fehlerbehandlung.
Es ist halt etwas tricky, wenn man dem Speichern-Unter-Dialog in das Ereignis-Makro eingreift, das vor dem Speichern ausgeführt wird.
LG
Franz

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Select Case ActiveSheet.Name
Case "Tabelle2", "Tab ABC"
'Diese Blätter ohne Prüfung drucken
Case Else
If ActiveSheet.Pictures.Count  6 Then
'prüfen ob die Datei mit dem vorgegebenem Namen geöffnet ist
If LCase(Dateiname & ".xlsm")  LCase(Me.Name) Then
Set wkbOpen = Application.Workbooks(Dateiname & ".xlsm")
If Not wkbOpen Is Nothing Then
Cancel = True
MsgBox "Die Datei mit Name """ & Dateiname & ".xlsm"" ist zur Zeit geöffnet." & vbLf  _
_
& "Bitte Datei erst schliessen!", vbOKOnly, "Makro: Workbook_BeforeSave"
GoTo Fehler
End If
End If
Resume01:
Cancel = True
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show (Dateiname)
Application.EnableEvents = True
Else
Cancel = True
MsgBox "Bitte alle geforderten Bilder einfügen!", _
vbOKOnly, "Makro: Workbook_BeforeSave"
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 9 'Datei mit vorgegebenem Namen ist nicht geöffnet
Resume Resume01
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Makro: Workbook_BeforeSave"
End Select
End With
Application.EnableEvents = True
End Sub

Beliebteste Forumthreads (12 Monate)

"speichern unter" Code klappt nicht 100%

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

"speichern unter" Code klappt nicht 100%

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread