@ Fritz!
31.12.2004 09:20:37
Josef
Dein Beitrag ist leider bereits im Archiv gelandet.
Dieser Code sollte funktionieren!
Im vorherigen hat das "Cancel=True" gefehlt, und damit ist eine Rekursion
entstanden!
Option Explicit
Dim strFile As String
Dim oldVal As Variant
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strFile1 As String
Dim strFile2 As String
'Prüfung ob "E1"/"C1" seit dem Öffnen geändert!
If strFile <> Sheets("Daten").[E1] & "-" & Left(Sheets("Daten").[C1], 4) & "-E.xls" Then
Cancel = True
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
On Error GoTo ERRORHANDLER
strFile1 = Sheets("Daten").[E1] & "-" & Left(Sheets("Daten").[C1], 4) & ".xls"
Me.SaveCopyAs strFile1
strFile2 = Sheets("Daten").[E1] & "-" & Left(Sheets("Daten").[C1], 4) & "-E.xls"
Workbooks(strFile).SaveCopyAs strFile2
Workbooks(strFile).Close False
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Workbooks.Open strFile1
Me.Close False
Exit Sub
Else 'wenn "E1"/"C1" seit dem Öffnen nicht geändert
Workbooks(strFile).Save
Windows(Me.Name).Activate
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Exit Sub
ERRORHANDLER:
MsgBox "Beim speichern ist Fehler ist aufgetreten!"
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End If
End Sub
Private Sub Workbook_Open()
strFile = Sheets("Daten").[E1] & "-" & Left(Sheets("Daten").[C1], 4) & "-E.xls"
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
Workbooks.Open strFile
Windows(Me.Name).Activate
Application.ScreenUpdating = True
Exit Sub
ERRORHANDLER:
MsgBox "Die Datei """ & strFile & """ wurde nicht gefunden!"
Application.ScreenUpdating = True
End Sub
Ich wünsche dir und deinen lieben einen guten Rutsch und alles Gute für 2005!
Gruß Sepp