title image


Smiley Re: Änderungsprotokoll per VBA
Hallo Micha,



folgender Code in das Klassenmodul der Mappe. Es wird eine Textdatei erstellt. Da musst du eventuell den Pfad anpassen, damit die Datei nicht auf dem lokalen Laufwerk landet.



Option ExplicitPrivate Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" ( _    ByVal lpBuffer As String, _    nSize As Long) As LongDim Username As StringPrivate Sub Workbook_Open()    Dim Buffer As String * 100, BuffLen As Long    BuffLen = 100    GetUserName Buffer, BuffLen    Username = Left$(Buffer, BuffLen)    Username = Left$(Username, InStr(Username, vbNullChar) - 1)    If Trim$(Username) = "" Then Username = Application.UsernameEnd SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    Dim intSpalte As Integer, lngZeile As Long    Dim strBuchstabe1 As String, strBuchstabe2 As String    Dim varArray_neu As Variant, strAdresse As String    Dim varArray_alt As Variant, intArrayspalte As Integer    Dim intFile As Integer, varNeu As Variant    Dim lngArrayzeile As Long, varAlt As Variant, bolneu As Boolean    Reset    intFile = FreeFile    If Dir("C:\Logfile.txt") = "" Then bolneu = True    Open "C:\Logfile.txt" For Append Access Write Lock Read Write As #intFile    If bolneu Then Print #intFile, "Datum und Zeit", "Wert alt", _        "Wert neu", "Zelle", "Tabelle", "Benutzer"    If Target.Count > 1 Then varArray_neu = Range(Target.Address) Else varNeu = Target    strAdresse = Selection.Address    With Application        .ScreenUpdating = False        .EnableEvents = False        .Undo    End With    If Target.Count > 1 Then        varArray_alt = Range(Target.Address)        Application.Undo        For intSpalte = Target.Column To Target.Column + Target.Columns.Count - 1            intArrayspalte = intArrayspalte + 1            lngArrayzeile = 0            For lngZeile = Target.Row To Target.Row + Target.Rows.Count - 1                lngArrayzeile = lngArrayzeile + 1                If varArray_alt(lngArrayzeile, intArrayspalte) <> _                    varArray_neu(lngArrayzeile, intArrayspalte) Then _                    Print #intFile, Now, varArray_alt(lngArrayzeile, intArrayspalte), _                    varArray_neu(lngArrayzeile, intArrayspalte), _                    Cells(lngZeile, intSpalte).Address(0, 0), Sh.Name, Username            Next        Next    Else        varAlt = Range(Target.Address)        Application.Undo        Print #intFile, Now, varAlt, varNeu, Target.Address(False, False), Sh.Name, Username    End If    Range(strAdresse).Select    With Application        .ScreenUpdating = True        .EnableEvents = True    End With    Close #intFileEnd SubPrivate Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)    If Target.Areas.Count > 1 Then        MsgBox "Auswahl nicht zulässig.", 48, "Hinweis"        Application.EnableEvents = False        Range(Target.Address).Cells(1, 1).Select        Application.EnableEvents = True    End IfEnd Sub
Gruß
Nepumuk


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: