Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1776to1780
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
Inhaltsverzeichnis

Protokollierung von Änderungen

Protokollierung von Änderungen
10.08.2020 12:10:30
Änderungen
Hallo zusammen,
ich habe vor einigen Jahren in irgend einem Excel-Forum einen VBA-Code entdeckt, den ich mir mal für alle Fälle gesichert habe.
Und wie es der Teufel so will benötige ich für ein Projekt genau jetzt diesen Code.
Hintergrund: Änderungen in einer Excel-Datei sollen dauerhaft protokolliert werden. So kann im Falle eines Falles kontrolliert werden welcher Zelleninhalt vor einer Änderung vorhanden war.
Der VBA-Code macht auch genau was er soll. Er protokolliert in einer CSV-Datei alle Änderungen die in der Datei gemacht werden. Alle Zellen in allen Tabellenblättern.
Alledings sollen nur bestimmte Blätter und darauf auch nur bestimmte Zellen "überwacht" werden.
Z.B. Tabelle1 ...Zellen A7 bis O500 und in Tabelle2 die Felder A7 bis M500.
Die richtige datei hat nämlich einiges mehr an Tabellenblättern Und eine Gesamtprotokollierung würde die CSV-Datei nur unnötig aufpumpen :-)
Wie muss man den Code ändern dass nur bestimmte Blätter und bestimmte Zellen protokolliert werden?
Als Anfänger ist der Code für mich leider ein Buch mit 7 Siegeln...
https://www.herber.de/bbs/user/139561.xlsm
Für eventuelle Hilfe jetzt schon einmal ein Dankeschön :-)
harti

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Protokollierung von Änderungen
10.08.2020 12:59:48
Änderungen
Hallo,
mit diesem Code hat sich jemand Mühe gegeben.
Ungeprüft: Diese Ergänzung könnten Dir helfen:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
dim Bo as boolean
Ar_Sht_Names = array("name1", "name2")
for i = 0 to ubound(Ar_Sht_Names)
if Ar_Sht_Names = Sh.Name then Bo = true
next i
if not bo then exit sub
In das Array werden alle Sheet-Namen eingetragen, die geprüft werden sollen.
mfg
AW: Protokollierung von Änderungen
10.08.2020 13:03:15
Änderungen
Hallo Fennek,
vielen Dank für die schnelle Rückmeldung.
An welcher Stelle müsste ich die Ergänzung denn einsetzen...?
Danke
harti
Anzeige
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
Anzeige
AW: Protokollierung von Änderungen
10.08.2020 13:40:28
Änderungen
Hallo Nepumuk,
danke für Deine Rückmeldung.
Bisher ist der Test allerdings ergebnislos.
In der CSV-Datei werde keine Daten geschrieben.
Ich versuch's noch einmal komplett neu und melde mich gleich noch einmal...
harti
AW: Protokollierung von Änderungen
10.08.2020 13:46:37
Änderungen
Wie ich gesagt habe.
Die Daten werden nicht in die CSV geschrieben.
Mit meinem ursprünglichen Code klappt's, nur sind das bei vielen Tabellenblättern
viel zu viel Daten. Deshalb die Beschränkung auf bestimmte Blätter...
AW: Protokollierung von Änderungen
10.08.2020 14:56:35
Änderungen
Hallo harti,
du musst in dieser Prozedur die Objektnamen der Tabellen anpassen:
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

Die Objektnamen findest du im Projektexplorer vor dem Namen der Tabellen auf der Exceloberflächen in Klammern. In deiner hochgeladenen Mappe Tabelle4 und Tabelle5.
Userbild
Gruß
Nepumuk
Anzeige
AW: Protokollierung von Änderungen
10.08.2020 15:25:20
Änderungen
Hallo Nepumuk,
Du bist mein heutiger Tagesheld :-)
Es funktioniert. Da wäre ich nie darauf gekommen. Für mich war Tabelle1 (wird ja in Excel so angezeigt) auch Tabelle1.
Super...da hast Du mir sehr viel Arbeit erspart.
Vielen Dank noch einmal.
harti

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige