AW: Protokollierung von Änderungen
10.08.2020 13:07:56
Änderungen
Hallo harti,
teste mal:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function CopyFileA Lib "kernel32.dll" ( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
#Else
Private Declare Function CopyFileA Lib "kernel32.dll" ( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
#End If
Private Const LOGFILE_PATH = "D:\test\"
Private Const LOGFILE_NAME = "LogFile.csv"
Private Const TEMP_PREFIX = "Temp_"
Private mavntValues As Variant
Private mintFileNumber As Integer
Private mstrUser As String
Private mblnInit As Boolean
Private mastrLogArrayMultiChange() As String
Private mstrMonitoringRange As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Pruefen ob Variablen initialisiert sind
If Not mblnInit Then Call InitLogFile
If Not Saved Then
Select Case MsgBox("Sollen Ihre Änderungen in '" & Name & _
"' gespeichert werden", vbExclamation Or vbYesNoCancel)
Case vbYes
'Logfile schliessen
Call CloseLogfile
'Speichern
Save
Case vbNo
'Logfile schliessen
Call CloseLogfile
'Temporaeres Logfile zurueckkopieren
Call CopyFileA(LOGFILE_PATH & TEMP_PREFIX & _
LOGFILE_NAME, LOGFILE_PATH & LOGFILE_NAME, 0&)
'Gespeichert Flag setzen
Saved = True
Case vbCancel
'Abbrechen Flag setzen
Cancel = True
End Select
End If
If Not Cancel Then
'Temporaeres Logfile loeschen
Call KillTempLogFile
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Pruefen ob Variablen initialisiert sind
If Not mblnInit Then Call InitLogFile
'Logfile schliessen
Call CloseLogfile
'Neue temporaere Kopie des Logfiles erstellen
Call CopyFileA(LOGFILE_PATH & LOGFILE_NAME, _
LOGFILE_PATH & TEMP_PREFIX & LOGFILE_NAME, 0&)
'Logfile wieder oeffnen
Call OpenLogfile
End Sub
Private Sub Workbook_Open()
'Variablen initialisieren
Call InitLogFile
'Temporaere Kopie des Logfiles erstellen
Call CopyFileA(LOGFILE_PATH & LOGFILE_NAME, _
LOGFILE_PATH & TEMP_PREFIX & LOGFILE_NAME, 0&)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Pruefen ob Variablen initialisiert sind
If Not mblnInit Then Call InitLogFile
'Wenn das aktive Blatt eine Tabelle ist
If TypeOf Sh Is Worksheet Then
With Sh
Select Case .CodeName
Case "Tabelle1"
'Ueberwachter Bereich
mstrMonitoringRange = "A7:O500"
'Array mit den vorhandenen Werten fuellen
mavntValues = .Range(mstrMonitoringRange)
Case "Tabelle2"
'Ueberwachter Bereich
mstrMonitoringRange = "A7:M500"
'Array mit den vorhandenen Werten fuellen
mavntValues = .Range(mstrMonitoringRange)
Case Else
'Kein ueberwachter Bereich
mstrMonitoringRange = vbNullString
'Array leeren
mavntValues = Empty
End Select
End With
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim blnMultiChange As Boolean
Dim lngColumn As Long, lngColumnOffset As Long
Dim lngRow As Long, lngRowOffset As Long
Dim lngRowNumber As Long, ialngIndex As Long
Dim strColumnLetter As String, strSheetName As String
Dim strDateTime As String
Dim avntValues As Variant
Dim objRange As Range, objArea As Range
'Pruefen ob Variablen initialisiert sind
If Not mblnInit Then Call InitLogFile
'Wenn die Tabelle ueberwacht wird
If mstrMonitoringRange <> vbNullString Then
'Ueberwachten Bereich aus geaenderten Bereich extrahieren
Set objRange = Intersect(Target, Sh.Range(mstrMonitoringRange))
'Wenn Aenderung im ueberwachten Bereich
If Not objRange Is Nothing Then
'Tabellenname holen
strSheetName = Sh.Name
'Datum und Uhrzeit der Aenderung
strDateTime = CStr(Now)
'Bereiche mit geaenderten Zellen einzeln durchlaufen
For Each objArea In objRange.Areas
'Versatz der Zeilen und Spalten gegen erste Zelle des ueberwachten Bereichs berechnen
lngRowOffset = objArea.Row - Sh.Range(mstrMonitoringRange).Row
lngColumnOffset = objArea.Column - Sh.Range(mstrMonitoringRange).Column
'Wenn mehr als eine Zelle geaendert wurde
If objArea.Count > 1 Then
'Flag setzen
blnMultiChange = True
'Array dimensionieren
Redim mastrLogArrayMultiChange(1 To objArea.Count)
'Index fuer Array setzen
ialngIndex = 0
End If
'Geaenderte Werte holen
avntValues = objArea.Value
'Wenn nur ein einzelner Wert geaendert wurde
If Not IsArray(avntValues) Then
'Array fuer einen Wert erzeugen
Redim avntValues(1 To 1, 1 To 1)
'Geaenderten Wert in das Array schreiben
avntValues(1, 1) = objArea.Value
End If
'Schleife ueber die geaenderten Spalten
For lngColumn = 1 To UBound(avntValues, 2)
'Spaltenbuchstabe holen
strColumnLetter = Split(Sh.Cells(1, lngColumn + _
objArea.Column - 1).Address, "$")(1)
'Erste Zeilennummer holen
lngRowNumber = objArea.Row
'Schleife ueber die geaenderten Zeilen
For lngRow = 1 To UBound(avntValues, 1)
'Pruefen ob tatsaechlich ein neuer Wert eingetragen wurde
If mavntValues(lngRow + lngRowOffset, lngColumn + _
lngColumnOffset) <> avntValues(lngRow, lngColumn) Then
'Index fuer Array wenn mehr als eine Zelle geaendert wurde hochzaehlen
ialngIndex = ialngIndex + 1
'Logfile schreiben
Call WriteLog(strDateTime, mavntValues(lngRow + _
lngRowOffset, lngColumn + lngColumnOffset), _
avntValues(lngRow, lngColumn), strColumnLetter & _
CStr(lngRowNumber), strSheetName, blnMultiChange, _
ialngIndex, False)
'Zeilennummer hochzaehlen
lngRowNumber = lngRowNumber + 1
End If
Next
Next
'Wenn mehr als eine Zelle geaendert wurde
If blnMultiChange Then Call WriteLog(vbNullString, Empty, Empty, _
vbNullString, vbNullString, True, ialngIndex, True)
Next
'Array neu fuellen
Call Workbook_SheetActivate(Sh)
'Wenn unabhaengige Bereiche geaendert wurden muss der "Rueckgaengig machen"
'Speicher geloescht werden da sonst das Protokoll nicht richtig geschrieben wird
If Target.Areas.Count > 1 Then
'Ereignisroutinen ausschalten
Application.EnableEvents = False
'Die oberste linke Zelle des geändeten Bereiches in sich selbst kopieren
Call Target.Cells(1, 1).Copy(Destination:=Target.Cells(1, 1))
'Ereignisroutinen einschalten
Application.EnableEvents = True
End If
End If
End If
End Sub
Private Sub OpenLogfile()
Open LOGFILE_PATH & LOGFILE_NAME For Append As #mintFileNumber
End Sub
Private Sub CloseLogfile()
Close #mintFileNumber
End Sub
Private Sub WriteLog( _
ByRef prstrDateTime As String, _
ByRef prvntOldValue As Variant, _
ByRef prvntNewValue As Variant, _
ByRef prstrAddress As String, _
ByRef prstrSheetName As String, _
ByRef prblnMultiChange As Boolean, _
ByRef prialngIndex As Long, _
ByRef prblnWriteMultiChangeArrayNow As Boolean)
'Array der Logeintraege schreiben
If prblnWriteMultiChangeArrayNow Then
'Wenn ueberhaupt Eintraege geaendert wurden
If prialngIndex > 0 Then
'Array an die Anzahl der tatsaechlich geaenderten Eintraege anpassen
Redim Preserve mastrLogArrayMultiChange(1 To prialngIndex)
'Array in CSV-Datei schreiben
Print #mintFileNumber, Join(mastrLogArrayMultiChange, vbCrLf)
End If
Else
'Wenn mehrere Zellen gleichzeitig geaendert wurden
If prblnMultiChange Then
'Logeintraege in ein Array schreiben
mastrLogArrayMultiChange(prialngIndex) = prstrDateTime & ";" _
& mstrUser & ";" & prstrSheetName & ";" & prstrAddress & ";" & _
CStr(prvntOldValue) & ";" & CStr(prvntNewValue)
Else
'Logfile direkt in CSV-Datei schreiben
Print #mintFileNumber, prstrDateTime & ";" & mstrUser & ";" & _
prstrSheetName & ";" & prstrAddress & ";" & _
CStr(prvntOldValue) & ";" & CStr(prvntNewValue)
End If
End If
End Sub
Private Sub KillTempLogFile()
'Pruefen ob temporaeres Logfile existiert
If Dir$(LOGFILE_PATH & TEMP_PREFIX & LOGFILE_NAME, _
vbHidden Or vbSystem) <> vbNullString Then
'Dateiattribut auf "normal" setzen
Call SetAttr(LOGFILE_PATH & TEMP_PREFIX & LOGFILE_NAME, vbNormal)
'Temporaeres Logfile loeschen
Call Kill(LOGFILE_PATH & TEMP_PREFIX & LOGFILE_NAME)
End If
End Sub
Private Sub InitLogFile()
Dim blnNewLog As Boolean
'Flag setzen
mblnInit = True
'Aufruf um Array zu fuellen
Call Workbook_SheetActivate(ActiveSheet)
'Alle Textdateien schliessen
Reset
'Freie Dateinummer holen
mintFileNumber = FreeFile
'Benutzername holen
mstrUser = Environ$("USERNAME")
'Pruefen ob Logfile existiert
blnNewLog = Dir$(LOGFILE_PATH & LOGFILE_NAME, _
vbHidden Or vbSystem) = vbNullString
'Logfile oeffnen
Call OpenLogfile
'Bei neuem Logfile
If blnNewLog Then
'Ueberschriften setzen
Print #mintFileNumber, "Datum und Uhrzeit;" & _
"Benutzer;Tabelle;Zelle;alter Wert;neuer Wert"
'Logfile schliessen
Call CloseLogfile
'als verstecke Systemdatei kennzeichnen
Call SetAttr(LOGFILE_PATH & _
LOGFILE_NAME, vbHidden Or vbSystem)
'Logfile wieder oeffnen
Call OpenLogfile
End If
End Sub
Private Sub Workbook1_BeforeClose(Cancel As Boolean)
Worksheets("daten-statistik").Select
Range("A3").Value = Application.UserName
Range("A5").Value = Format$(Date, "dd.mm.yyyy") & " --- " & Format$(Time, "Hh:Nn")
Call Save
End Sub
Gruß
Nepumuk