AW: History anlegen
17.06.2014 09:18:03
Nepumuk
Hallo,
um Änderungen von Zellwerten zu überwachen findest du hier eine ganz gut Lösung denn es werden sowohl der alte wie der neue Wert protokolliert und ist für den User praktisch nicht bemerkbar da es sehr schnell ist:
http://www.office-loesung.de/ftopic599975_0_0_asc.php
Um das löschen von Zeilen oder Spalten zu überwachen hab ich hier mal ein Beispiel:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Verify_Rows(Me)
Case 0 'no row delete or insert
Case 1 'row insert
MsgBox Application.UserName & " insert a row"
Case 2 'row delete
MsgBox Application.UserName & " delete a row"
End Select
End Sub
' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Verify_Columns(Me)
Case 0 'no column delete or insert
Case 1 'column insert
MsgBox Application.UserName & " insert a column"
Case 2 'column delete
MsgBox Application.UserName & " delete a column"
End Select
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Const ERROR_VALUE As String = "#REF!"
Public Function Verify_Rows(pobjSheet As Worksheet) As Integer
Const LOCAL_NAME As String = "Last_Row"
Dim objName As Name
Dim blnFound As Boolean
For Each objName In pobjSheet.Names
If objName.Name = pobjSheet.Name & "!" & LOCAL_NAME Then
blnFound = True
Exit For
End If
Next
If blnFound Then
If objName.RefersTo = "=" & pobjSheet.Name & "!" & ERROR_VALUE Then
Verify_Rows = 1
Else
If objName.RefersToRange.Row = pobjSheet.Rows.Count Then
Verify_Rows = 0
Else
Verify_Rows = 2
End If
End If
End If
pobjSheet.Names.Add Name:=LOCAL_NAME, RefersTo:= _
pobjSheet.Cells(pobjSheet.Rows.Count, 1), Visible:=False
End Function
Public Function Verify_Columns(pobjSheet As Worksheet) As Integer
Const LOCAL_NAME As String = "Last_Column"
Dim objName As Name
Dim blnFound As Boolean
For Each objName In pobjSheet.Names
If objName.Name = pobjSheet.Name & "!" & LOCAL_NAME Then
blnFound = True
Exit For
End If
Next
If blnFound Then
If objName.RefersTo = "=" & pobjSheet.Name & "!" & ERROR_VALUE Then
Verify_Columns = 1
Else
If objName.RefersToRange.Column = pobjSheet.Columns.Count Then
Verify_Columns = 0
Else
Verify_Columns = 2
End If
End If
End If
pobjSheet.Names.Add Name:=LOCAL_NAME, RefersTo:= _
pobjSheet.Cells(1, pobjSheet.Columns.Count), Visible:=False
End Function
Da werden aber nur ganze Zeilen bzw. Spalten berücksichtigt. Wenn ich das Einfügen / Löschen von einzelnen Zellen berücksichtigen wollte, bräuchte ich in jeder Spalte und jeder Zeile einer Tabelle einen Namen. Das wären 1.064.960 Namen die bei jeder Änderung in der Tabelle abgeklappert werden müsste. Damit würde ein vernünftiges Arbeiten in der Tabelle unmöglich.
Gruß
Nepumuk