Benutzernamen in Zellen bei Änderungen in Bereichen

Forumthread: Benutzernamen in Zellen bei Änderungen in Bereichen
2 Beiträge zu diesem Forumthread
Anzeige

Forumthread: Benutzernamen in Zellen bei Änderungen in Bereichen

31.03.2025 13:06:03

hkoepp63

Hallo Zusammen,
für das gleiche Projekt, wo ich den Zeilenumbruch benötigte, muss ich einen Benutzernamen in ein Feld automatisch eintragen.
Immer bei der letzten Änderung in dem Bereich muß der Benutzername eingetragen werden.

In den Bereichen E4:E8 und E12:F12 werden Einträge vorgenommen, dann soll in E8 das altuelle Datum uns in E9 der Benutzername eingetragen werden.

In den Bereichen E14:E16 und E19:E20 werden Einträge vorgenommen, dann soll in E17 das aktuelle Datum und in E18 der aktuelle Benutzername eingetragen werden

Das Datum und der Benutzername in E8, E17 und E9, E18 können unterschiedlich sein, weil an unterschiedlichen Tagen oder unterschiedlichen Kollegen.
Insgesamt sind es max.12 Bereiche. 2 Trafos (Anfang und Ende) und 10 Muffen.
Ich bekomme es hin, daß ein Benutzername eingetrgen wird. Aber ich bekomme keine Unterschiedlichen Benutzernamen für unterschiedliche Bereiche hin.

Vielen Dank im Voraus für Eure Unterstützung.

Das Beispiel habe ich hochgeladen:

https://www.herber.de/bbs/user/176504.xlsm

Beste Grüße und vielen Dank im Voraus.

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Benutzernamen in Zellen bei Änderungen in Bereichen

31.03.2025 13:40:16

UweD
AW: Benutzernamen in Zellen bei Änderungen in Bereichen

31.03.2025 18:23:42

hkoepp63

AW: Benutzernamen in Zellen bei Änderungen in Bereichen

31.03.2025 13:40:16

UweD

HAllo

Ergänze den Code so.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    

    If Not Intersect(Union(Range("E4:E8"), Range("E12:F12")), Target) Is Nothing Then

        Application.EnableEvents = False

        Range("E8") = Format(Now, "DD:MM:YYYY hh:mm")

        Range("E9") = Environ("Username")

        Application.EnableEvents = True

    End If

    

    If Not Intersect(Union(Range("E14:E16"), Range("E19:F20")), Target) Is Nothing Then

        Application.EnableEvents = False

        Range("E17") = Format(Now, "DD:MM:YYYY hh:mm")

        Range("E18") = Environ("Username")

        Application.EnableEvents = True

    End If

    

    '...

    

    

    If Intersect(Target, Range("b6")) Is Nothing Then Exit Sub

    Call ausblenden

    Call Seitenumbruch

    

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub