Supportnet / Forum / Tabellenkalkulation
Excel: Änderung eines Bereiches dokumentieren
Frage
Hallo Zusammen,
In meinem Excel möchte ich alle Änderungen dokumentieren. Beim Ändern einzellner Zellen habe ich das hinbekommen. Aber sobald ich mehrere Zellen auf einmal ändere, kann ich in diesen Zellen den alten Wert nicht ermitteln.
in der Tabelle steht:
Option Explicit
Public varValue As Variant
Public strAddress As String
Const Pfad = "C:\Temp\"
'Private Sub Worksheet_Change(ByVal Target As Range)
Call ZPREG_Change(Target, varValue, Pfad)
End Sub
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call ZPREG_SelectionChange(varValue, strAddress)
End Sub
und im Modul:
Option Explicit
Const Pfad = "C:\Temp\"
Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
'
Sub ZPREG_Change(ByVal Target As Range, varValue, Pfad)
Dim c
Dim f, NewVal, OldVal, Satz, UserName As String
Dim FileName As String
Dim FileNumber
FileNumber = FreeFile
FileName = Pfad & "PRIMUS.log"
Open FileName For Append As #FileNumber
UserName = syGetUserName
For Each c In Target
On Error Resume Next
OldVal = CStr(varValue)
NewVal = CStr(c.Value)
If c.HasFormula Then NewVal = CStr(c.Formula)
If (OldVal <> NewVal) Then _
Call SchreibSatz(FileNumber, _
UserName, _
c.Address, _
OldVal, _
NewVal)
Next
Close #FileNumber
End Sub
Sub ZPREG_SelectionChange(varValue, strAddress)
varValue = ActiveCell.Value
If ActiveCell.HasFormula Then varValue = CStr(ActiveCell.Formula)
strAddress = ActiveCell.Address
End Sub
Private Sub SchreibSatz(FileName, UserName, Cell, OldVal, NewVal)
Dim Satz As String
Satz = Format(Date, "dd.mm.yyyy") & " " & Format(Time, "hh:nn:ss") & " " _
& UserName & " " & Cell & " °" & OldVal & "° -> °" & NewVal & "°"
Write #FileName, Satz
End Sub
Private Function syGetUserName() As String
Dim lpBuff As String * 25
Get_User_Name lpBuff, 25
syGetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function
Kann mir hier jemand helfen? Wahrscheinlich habe ich mal wieder irgendwo nen Knoten drin und find ihn blos nicht...
Grüße
Sebastian