Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
540to544
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
540to544
540to544
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

@ Fritz!

@ Fritz!
31.12.2004 09:20:37
Josef
Hallo Fritz!
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: @ Fritz!
Fritz
Hallo Sepp,
prima, herzlichen Dank!
Nocheinmal Dir und Deiner Familie (auch an Sebastian) guten Rutsch und alles Gute für 2005
Fritz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige