AW: hier (m)eine Variante ...
19.07.2018 06:06:56
Jürgen
Hallo Matthias,
hat irgendwie nicht geklappt.
Ich erhalte die Fehlermeldung:
"Fehler beim Kompilieren"
"Mehrfachdeklaration im aktuellen Gültigkeitsbereich"
Ich glaub das liegt an meine gesamten Worksheet_Change-Code.
Hierin las ich ein Log-File mitschreiben, in dem alle Änderungen
in dem Tabellenblatt mitgeschrieben werden.
Ich leg mal den gesamten Code für Worksheet_Change bei.
Vielleicht hast ja ne Idee wie man das Problem "umschiffen" kann.
Vielen Dank schon mal im Voraus.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="excelfreigeben"
ActiveSheet.EnableSelection = xlUnlockedCells
ActiveSheet.Protect Password:="excelfreigeben"
If Target.Row > 1000 Then Exit Sub '
Dim strDatei As String, strText As String
Dim strZeit As String, strUser As String, strZelle As String, strOld As String, strNeu As _
String
Dim intFile As Integer, RnG As Range
Const strDELIM As String = "|" 'Logfile Delimiter - ggf. anpassen
Const lenUser As Integer = 15 'Anzahl Zeichen für Username
Const lenAdresse As Integer = 6 'Anzahl Zeichen für Zelladress
Const lenWert As Integer = 10 'min. Anzahl Zeichen für Wert alt und neu
Const FormatZeit As String = "YYYY-MM-DD hh:mm:ss" 'Format für Zeitstempel
intFile = FreeFile
With ThisWorkbook
'Logbuch in allgemeinem, öffentlichen Verzeichnis, eine Datei je User
'' strDatei = "C:\Users\Public\Test\Data" & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis der Datei, eine Datei je User
''strDatei = .Path & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis des Users
''42506strDatei = Environ("USERPROFILE") & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis der Datei, eine Datei für alle User
strDatei = .Path & "\LogBuch_" & "_" & Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
End With
Open strDatei For Append As #intFile
If LOF(intFile) = 0 Then
'Texte in Titelzeile
With Application.WorksheetFunction
strZeit = "Zeitstempel"
strZeit = strZeit & VBA.Space(.Max(0, Len(FormatZeit) - Len(strZeit)))
strUser = "User"
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = "Zelle"
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = "alter-Wert"
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNeu = "neuer-Wert"
strNeu = strNeu & VBA.Space(.Max(0, lenWert - Len(strNeu)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNeu & strDELIM
End With
Print #intFile, strText
'Text für Trennzeile ("-" und Trennzeichen)
strText = String(Len(strZeit), "-") & strDELIM & String(Len(strUser), "-") & strDELIM _
_
& String(Len(strZelle), "-") & strDELIM _
& String(Len(strOld), "-") & strDELIM & String(Len(strNeu), "-") & strDELIM
Print #intFile, strText
End If
For Each RnG In Target.Cells
If RnG.Value mstrOld(RnG.Row, RnG.Column) Then
With Application.WorksheetFunction
strZeit = Format(Now, "YYYY-MM-DD hh:mm:ss")
strUser = Environ("username")
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = VBA.Replace(RnG.Address, "$", "")
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = mstrOld(RnG.Row, RnG.Column)
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNeu = IIf(RnG.Value = "", "#gelöscht#", RnG.Value)
strNeu = strNeu & VBA.Space(.Max(0, lenWert - Len(strNeu)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNeu & strDELIM
End With
Print #intFile, strText
End If
Next
Close #intFile
'Doppelte Einträge verhindern in der Spalte E
Dim Bereich As Range, RnG As Range
Set Bereich = Range("E2:E2000")
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Bereich, Target) Is Nothing Then Exit Sub
Wert = Target.Value
If WorksheetFunction.CountIf(Bereich, Target.Value) > 1 Then
MsgBox "Doppelter Eintrag nicht zulässig" & vbNewLine & vbNewLine & "der von ihnen _
eingebene Wert wird wieder gelöscht" & vbNewLine & vbNewLine & "Bitte überprüfen sie ihre gewählte Leitungsführung", vbOKOnly, "Eintragung unzulässig!"
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
For Each RnG In Bereich
If RnG = Wert Then RnG.Select: Exit Sub
Next
Target.Select
End If
'Doppelte Einträge Verhindern geht bis hier her
End Sub