Worksheet_Change-Event Bug bei Dropdown
24.06.2022 15:57:39
Lukas
ich habe ein Makro geschrieben, welches bei der Änderung einer Zelle in der jeweiligen Zeile den Verfasser und das Datum einträgt. Das ganze funktioniert soweit auch alles wie gewünscht. Wenn ich nun aber einen Doppelklick in eine Zelle mache, in welcher eine Dropdown hinterlegt ist (per Datenüberprüfung) und dann auf die Auswahl des Dropdown-Menüs klicke, bekomme ich den Laufzeitfehler 50290 "Anwendungs- oder objektdefinierter Fehler".
Hat jemand eine Idee wie man dieses Verhalten umgehen kann?
Code siehe unten.
Public Sub ChangeLog(ByVal Target As Range, Worksheet As Object)
Dim neValues As Range
Dim tableRange As Range
Dim targetRow As Integer
Dim changeDateColumn As Integer
Dim changedByColumn As Integer
Dim uniqueIDColumn As Integer
Dim tableHeader As Integer
Dim GUID As String
Dim uniqueID As String
'Die folgenden Variablen beschreiben den SpaltenIndex der ChangeDate & Erfasser & Unique Spalte. Diese sind unter Formeln --> Namensmanager definiert
changeDateColumn = Worksheet.Names("ChangeDate").RefersToRange.Column
changedByColumn = Worksheet.Names("ChangedBy").RefersToRange.Column
uniqueIDColumn = Worksheet.Names("UniqueID").RefersToRange.Column
'Hier wird geprüft ob es sich bei der Änderung um den ChangeLog oder die UniqueID handelt, wenn ja beende an dieser Stelle
If Target.Column = changeDateColumn Or Target.Column = changedByColumn Or Target.Column = uniqueIDColumn Then
Exit Sub
End If
'tableRange beschreibt den Bereich der definierten Tabelle auf dem Arbeitsblatt
Set tableRange = Worksheet.ListObjects(1).DataBodyRange
tableHeader = Worksheet.ListObjects(1).HeaderRowRange.Row
'Prüft, ob sich die geänderte Zelle in der Tabelle befindet
On Error Resume Next
Set neValues = Intersect(Target, tableRange)
On Error GoTo 0
'Wenn sich die Zelle in der Tabelle befindet, dann trage in der entsprechenden Zelle das Datum und den Erfasser ein. Target.Row tableHeader verhindert Bugs, in denen die Spaltenbeschriftung verändert wird.
If Not neValues Is Nothing And Target.Row tableHeader Then
Worksheet.Cells(Target.Row, changeDateColumn).Value = Now
Worksheet.Cells(Target.Row, changedByColumn).Value = Environ("Username")
End If
uniqueID = Worksheet.Cells(Target.Row, uniqueIDColumn).Value
If uniqueID = "" Then
GUID = GenGuid()
Worksheet.Cells(Target.Row, uniqueIDColumn).Value = GUID
End If
End Sub