AW: "Gespeichert durch" in Zeile hinterlegen
03.03.2008 09:08:02
Foxi
Hallo,
habe es so weit in den Griff bekommen. Habe sogar noch das Datum in Spalte A eingefügt.
Hier mein Code:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Saved Then Exit Sub
Tabelle1.Unprotect
With Worksheets("Messbericht")
.Range("C" & IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp).Row, _
_
.Rows.Count)) = Application.UserName
End With
Tabelle1.Protect
Tabelle1.Unprotect
With Worksheets("Messbericht")
.Range("A" & IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp).Row, _
_
.Rows.Count)) = Date
End With
Tabelle1.Protect
If InSpeicher = 1 Then Exit Sub
InSpeicher = 1
If MsgBox("Wollen Sie die Veränderungen speichern?", vbYesNo + vbQuestion, "Speichern ?") = _
vbYes Then
blenden 2
Else
ThisWorkbook.Saved = True
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Tabelle1.Unprotect
With Worksheets("Messbericht")
.Range("C" & IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp).Row, _
_
.Rows.Count)) = Application.UserName
End With
Tabelle1.Protect
Tabelle1.Unprotect
With Worksheets("Messbericht")
.Range("A" & IIf(IsEmpty(.Cells(.Rows.Count, 3)), .Cells(.Rows.Count, 3).End(xlUp).Row, _
_
.Rows.Count)) = Date
End With
Tabelle1.Protect
If SaveAsUI Then
Dim StDateiname As String
StDateiname = Application.GetSaveAsFilename(fileFilter:="Excel-Arbeitsmappen (*.xls), *. _
xls")
If UCase(StDateiname) <> "FALSCH" Then ' ein Dateinmae wurde eingegeben
Application.EnableEvents = False ' Reaktion auf Aktion in Arbeitsmappe _
abschalten
ThisWorkbook.SaveAs Filename:=StDateiname
Application.EnableEvents = True ' Reaktion auf Aktion in Arbeitsmappe _
einschalten
End If
Cancel = True ' speichern unter Dialog abbrechen
End If
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
If StTabelle = "" Then
StTabelle = ActiveSheet.Name
' ausblenden aller Register außer Sheets("Makros_deaktiviert") mit xlVeryHidden (2)
' dies hat den Vorteil, sie können nur per VBA eingeblendet werden.
blenden 2 ' Tabellen ausblenden
Cancel = True
End If
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
' damit das einblenden der Register nicht als Veränderung der Datei angesehen wird
' Schalter Veränderung der Datei zurückstellen
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
blenden -1 ' Tabellen einblenden
Worksheets("Messbericht").Select ' damit diese Tabelle beim Start angezeigt _
wird
' damit das einblenden der Register nicht als Veränderung der Datei angesehen wird
' Schalter Veränderung der Datei zurückstellen
ThisWorkbook.Saved = True
End Sub
Gruß Foxi