AW: Letzter Dateibenutzer
03.09.2006 15:20:45
Daniel
Hallo
für diesen Zweck habe ich mir folgendes System zusammengebaut:
1. erstelle ein zusätlichen Sheet, nenne es Log (in diesem werden die Nutzer und änderungen mitgeloggt.
2. in diese Sheet fügst du die Überschriften "Datum", "Zeit", "User", "geänderte Zellen" ein
3. du kopierst den unten angefügten Code ins Klassenmodul des Workbooks
4. du fügst in der Select-Case-Routine deinen Usernamen ein.
Das Makro erfüllt folgendnen Zweck:
wenn ein fremder User die Datei öffnet, wird das Datum, die Zeit und der System-Username in die 2. Zeile geschrieben, die alten Einträge werden nach unten geschoben.
Damit sich die Datei nicht zusehr aufbläht wird die 100. Zeile wieder gelöscht.
Dann wird sofort gespeichert, damit sehe ich auch, wenn ein User die Datei ohne Änderungen geöffnet hat. (kann hilfreich sein, um zu beurteilen ob eine Datei, die nur Informationen bereit stellt, tatsächlich genutzt wird)
Falls du das nicht benötigtst, kannst du das Speichern ja rausnehmen.
Das Log-Sheet wird für den User unsichtbar gemacht.
Sobald der User änderungen vornimmt, werden Sheet-Name und Zellbereich mitgeschrieben.
Wenn du, bzw ein ausgesuchter Personenkreis, der in der Select-Case-Anweisung festzulegen ist, die Datei öffnet, wird das Log-Sheet sichtbar und es werden keine Einträge gemacht.
Natürlich lässt sich der Schutz umgehen, wenn Makros deaktiviert werden, aber im Normalfall reichts.
Option Explicit
Public Mitloggen As Boolean
Private Sub Workbook_Open()
Application.EnableEvents = False
Select Case Environ("Username")
Case "Dein Username"
Sheets("Log").Visible = -1
Mitloggen = False
Case Else
With Sheets("Log")
.Visible = 2
.Rows(101).Delete
.Rows(2).Insert
.Cells(2, 1).Value = Date
.Cells(2, 2).Value = Time
.Cells(2, 3).Value = Environ("Username")
End With
ThisWorkbook.Save
Mitloggen = True
End Select
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
with sheets("Log")
If Mitloggen Then .Cells(2, 4).Value = .Cells(2, 4).Value & Sh.Name & "!" & Target.Address & " \ "
end with
Application.EnableEvents = True
End Sub
Gruß, Daniel