Verstecktes Blatt wieder anzeigen
Thomas
wir haben eine Datei in welcher ein Tabellenblatt "Protokoll" existiert in welchem Veränderungen am ersten Tabellenblatt mit Name und Zeit dokumentiert werden. Das hatte auch soweit bei der Einrichtung funktioniert und wurde danach eine Zeit lang nicht benötigt.
Nun ist jedoch der Zeitpunkt gekommen wo dies mal sporadisch geprüft werden solle, leider wissen wir gerade nicht wie dies gemacht wird, dass das versteckte TB "Protokoll" wieder sichtbar gemacht wird.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Worksheets("Protokoll").Protect Password:="geheim", UserInterfaceOnly:=False
Dim intSpalte As Integer, lngZeile As Long, strBuchstabe1 As String, strBuchstabe2 As _
String
Dim varArray_neu As Variant, varArray_alt As Variant, intArrayspalte As Integer, strAdresse _
_
As String
Dim lngArrayzeile As Long, lngLetzteZeile As Long, varAlt As Variant, varNeu As Variant
If Sh.name "Protokoll" Then
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
With Worksheets("Protokoll")
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
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varArray_alt(lngArrayzeile, _
intArrayspalte)
.Cells(lngLetzteZeile, 3) = varArray_neu(lngArrayzeile, _
intArrayspalte)
.Cells(lngLetzteZeile, 4) = Cells(lngZeile, intSpalte).Address(0, 0) _
_
.Cells(lngLetzteZeile, 5) = Sh.name
.Cells(lngLetzteZeile, 6) = Username
End If
Next
Next
End With
Else
varAlt = Range(Target.Address)
Application.Undo
With Worksheets("Protokoll")
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varAlt
.Cells(lngLetzteZeile, 3) = varNeu
.Cells(lngLetzteZeile, 4) = Target.Address(False, False)
.Cells(lngLetzteZeile, 5) = Sh.name
.Cells(lngLetzteZeile, 6) = Username
End With
End If
Range(strAdresse).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Kann hier jemand erkennen was wir machen müssen?
Vielen Dank, Tom