AW: zu guter Letzt
06.11.2003 08:19:06
Harald Kapp
Hallo Silvio,
siehe Kommentare.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const Logfilename = "\Archiv\\Aenderungen_log.txt"
Dim User As String
Dim Protokoll As Long
Dim Logfile As String
Dim Zelle As Range
Dim S_Alpha As String ' Variable für den String, der der Spalztennummer entspricht (1=A, 2=B, 26=Z, 27=AA...
User = UserName()
Logfile = ActiveWorkbook.Path & Logfilename ' Logfile im gleichen Pfad ablegen, wie die Excel-Datei.
Open Logfile For Append As #1
' Behandlung der Spalten>Z, da dann mit AA, AB etc. weitergemacht wird.
If Target.Column > 26 Then
S_Alpha = Chr(Asc("A") + (Target.Column \ 26) - 1) & Chr(Asc("A") + (Target.Column Mod 26) - 1) ' = div-Operator
Else
S_Alpha = Chr(Asc("A") + Target.Column - 1)
End If
' Chr (Asc("A") + Target.Column - 1) oops, diese Zeile ist wohl überflüssig. Überbleibsel vom Testen
' Wurde 1 Zelle geändert (count=1) oder mehrere (Else-Zweig) ?
' Die Print-Anweisung schreibt einfach den dahinter mit & gebildeten Stringg in das Logfile
If Target.Cells.Count = 1 Then
Print #1, Date & ", " & User & ": " & "geänderter Bereich = " & ActiveSheet.Name & ", " & S_Alpha & Target.Row & Chr(13) & _
"alter Wert = """ & AlterWert & """" & Chr(13) & _
"neuer Wert = """ & Target.Text & """" & Chr(13)
Else
For Each Zelle In Target
Print #1, Date & ", " & User & ": " & "geänderter Bereich = " & ActiveSheet.Name & ", " & S_Alpha & Zelle.Row & Chr(13) & _
"alter Wert = """ & "nicht zu ermitteln" & """" & Chr(13) & _
"neuer Wert = """ & Zelle.Text & """" & Chr(13)
Next Zelle
End If
Close #1
End Sub
' Diese Routine sichert lediglich VOR einer Änderung den bisherigen Wert der Zielzelle
' da nach der Änderung (wenn Sub Worksheet_Change() aufgerufen wird, siehe oben) der alte Wert nicht mehr zur Protokollierung
' zur Verfüguzng steht
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
AlterWert = Target ' Wert sichern, wenn neue Zelle selektiert wird. Ersatz für ein "Before_Change" Ereignis.
End Sub
' Fragt den User Namen vom System ab und begrenzt ihn auf max. 100 Zeichen
Function UserName() As String
Dim B As String * 100
Dim L As Long
L = 100
GetUserName B, L
UserName = Left(B, L - 1)
End Function
Mehr gibt's eigentlich nicht zu erklären.
Harald