30.01.2019, 11:05
Hallo,
ich habe folgendes Makro zusammengebaut.
Damit möchte ich, wenn in der Spalte G der Wert einer Zelle auf "Ja" geändert wird in bestimmten Zellen dieser Zeile Userdaten, Datum, etc. eingetragen wird.
Das Blatt ist geschützt weil der User manuell keine Daten in Spalten die vom Makro versorgt werden eintragen soll.
Ich hebe zuerst den Schutz auf und lasse dann das Makro laufen.
Der objUser.FullName wird noch eingetragen dann bricht das Makro jedoch ab, wenn das Datum in die Spalte 10 eingetragen werden soll (Laufzeitfehler '1004' Anwendungs- oder objektdefinierter Fehler)
Es schaut so aus als würde der Blattschutz wieder aktiv sein.
Wenn ich vor jedem eintragen der weiteren Daten den Blattschutz wieder per Makro aufhebe, funktioniert es.
Wie kann ich dauerhaft den Blattschutz aufheben oder den Code anders gestalten?
ich habe folgendes Makro zusammengebaut.
Damit möchte ich, wenn in der Spalte G der Wert einer Zelle auf "Ja" geändert wird in bestimmten Zellen dieser Zeile Userdaten, Datum, etc. eingetragen wird.
Das Blatt ist geschützt weil der User manuell keine Daten in Spalten die vom Makro versorgt werden eintragen soll.
Ich hebe zuerst den Schutz auf und lasse dann das Makro laufen.
Der objUser.FullName wird noch eingetragen dann bricht das Makro jedoch ab, wenn das Datum in die Spalte 10 eingetragen werden soll (Laufzeitfehler '1004' Anwendungs- oder objektdefinierter Fehler)
Es schaut so aus als würde der Blattschutz wieder aktiv sein.
Wenn ich vor jedem eintragen der weiteren Daten den Blattschutz wieder per Makro aufhebe, funktioniert es.
Wie kann ich dauerhaft den Blattschutz aufheben oder den Code anders gestalten?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Call Schutz_aufheben
Application.ScreenUpdating = False
Dim KeyCells As Range
Set KeyCells = Range("G:G")
Dim Netzwerk As Object
Dim objSysInfo As Object, objUser As Object
Set Netzwerk = CreateObject("wscript.network")
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Cells(Target.Row, 7).Value = "Ja" Then
Cells(Target.Row, 8) = objUser.FullName
Cells(Target.Row, 10) = Date
Cells(Target.Row, 11) = Now
Cells(Target.Row, 12) = Netzwerk.UserName
Cells(Target.Row, 13) = Netzwerk.Computername
End If
End If
Call Schutz_aktivieren
Application.ScreenUpdating = True
End Sub
LG Herbert
Windows 10
Office 365
Windows 10
Office 365