AW: Dokumentänderungen auf versteckter Seite....
22.06.2015 17:17:34
Malte
Habe inzwischen diesen Code gefunden:
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
Dim lngLZ As Long
Dim rngZelle As Range
On Error GoTo Fehler
'Zellwertänderungen aller Tabellen in Tabelle 'wksDoku' eintragen
'Ausnahme: Zelländerung in wksDoku
If Sh.CodeName "wksDoku" Then
'damit DIESE Prozedur durch Eingaben in wksDoku
'NICHT gestartet wird
Application.EnableEvents = False
With wksDoku
'erste freie Zeile in wksDoku ermitteln
lngLZ = .Cells(1, 1).End(xlDown).Row + 1
'wenn wksDoku voll dann alte Inhalte löschen
If lngLZ > Rows.Count Then
Call NeuesProtokoll
'erste freie Zeile in wksDoku ermitteln
lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
.Cells(lngLZ, 2) = ActiveSheet.Name
.Cells(lngLZ, 3) = ActiveSheet.CodeName
.Cells(lngLZ, 6) = Environ("Username")
.Cells(lngLZ, 7) = Environ("Computername")
.Cells(lngLZ, 8) = ThisWorkbook.FullName
'falls gleichzeitige Eingabe in mehreren Zellen
For Each rngZelle In Target
.Cells(lngLZ, 1) = Now
.Cells(lngLZ, 4) = rngZelle.Address(False, False)
If rngZelle.Value = "" Then
.Cells(lngLZ, 5) = ""
Else
.Cells(lngLZ, 5) = rngZelle.Value
End If
lngLZ = lngLZ + 1
If lngLZ > Rows.Count Then
Call NeuesProtokoll
'erste freie Zeile in wksDoku ermitteln
lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Next
End With
Application.EnableEvents = True
End If
Exit Sub
Fehler:
'im Fehlerfall FehlerNr. und Fehlerbeschreibung
'in nächste Zeile von wksDoku eintragen und weitermachen
'erste freie Zeile in wksDoku ermitteln
lngLZ = wksDoku.Cells(1, 1).End(xlDown).Row + 1
'VOR dem schreiben prüfen
'ob wksDoku voll dann alte Inhalte löschen
If lngLZ > Rows.Count Then
Call NeuesProtokoll
'erste freie Zeile in wksDoku ermitteln
lngLZ = wksDoku.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
With wksDoku
.Cells(lngLZ, 1) = Now
.Cells(lngLZ, 2) = "Err.Number: " & Err.Number
.Cells(lngLZ, 3) = "Err.Description: " & Err.Description
End With
lngLZ = wksDoku.Cells(1, 1).End(xlDown).Row + 1
'NACH dem schreiben prüfen
'ob wksDoku voll dann alte Inhalte löschen
If lngLZ > Rows.Count Then
Call NeuesProtokoll
'erste freie Zeile in wksDoku ermitteln
lngLZ = wksDoku.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Resume Next
End Sub
Private Sub NeuesProtokoll()
'entfernt alle Protololleinträge in wksDoku
'und schafft damit Platz für neue
With wksDoku
.Range(.Cells(3, 1), .Cells(Rows.Count, Columns.Count)).Clear
.Cells(3, 1) = Now
.Cells(3, 2) = "ALTES PROTOKOLL GELÖSCHT!!!"
'erste freie Zeile in wksDoku ermitteln
'lngLZ = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
'MsgBox "neues Protokoll"
End Sub
Und auch angewandt.
Das einzige was jetzt noch fehlt ist, dass mir zu den geänderten Zellen die dazugehörige Person in den gleichen Zeilen ausgespuckt wird.
Könnte zum Beispiel statt des Feldes "ändernder Benutzer" eingefügt werden, allerdings weiß ich nicht wie ich das anpacken soll.
Vielen Dank im Voraus!
Malte