Zellen der Vorwoche sperren

Maverick_57 · 2024-09-30T16:59:02+00:00

Hallo zusammen, ich habe folgende Problemstellung: in einer Zeiterfassung (es kamen in der Vergangenheit Unregelmäßigkeiten vor ;-)) möchte der Arbeitgeber folgende Zusatzfunktion haben: am ersten Arbeitstag der Folgewoche (muss nicht notwendig Montag sein, da auch TZ-Kräfte, die erst am Di oder Mi arbeiten) soll eine Abfrage erscheinen, ob die Vorwoche so korrekt erfasst wurde. Bei Antwort "Nein" soll der MA die Möglichkeit bekommen, die Daten der Vorwoche zu pflegen. Danach und bei Antwort "Ja" sollen die Eingabezellen der Vorwoche (Spalten C:I) gesperrt werden, so dass bei aktiviertem Blattschutz (aus einem Makro heraus) keine nachträgliche Bearbeitung dieser Zellen mehr möglich ist. Der Bearbeitungszeitraum soll immer für die Vorwoche gelten, und zwar von Montag bis Samstag. Daten älter als eine Woche sollen nicht mehr geändert werden können (außer durch Eingriff des Admin). Für die erste Woche des Monats soll der Änderungszeitraum vom 1. des Monats bis zum drauffolgenden Samstag gehen. Ich suche jetzt ein Makro, dass den Sperrvermerk auf die angesprochenen Zellen setzt. Ich hoffe, ich konnte mein Anliegen halbwegs klar darstellen? Beipieldatei: https://www.herber.de/bbs/user/172499.xlsm

Hallo

Du hast mich fast an mir zweifeln lassen.
Ich hatte was programmiert und der Code lief immer auf einen Fehler, den ich mir nicht erklären konnte,

Bis ich gesehen habe, das du das 1904 Datumssystem in der Datei verwendest. :-(
Warum?

Egal. hab die Einstellung nun ausgelesen und berücksichtigt.

- Rechtsclick auf den Tabellenblattreiter vom Blatt Mastermonat
- Code anzeigen
- Rechts diesen Code reinkopieren

Bei Aktivierung des Blattes läuft das Makro ab

Private Sub Worksheet_Activate()

    Dim Zeile As Long, Z1 As Integer, LR As Long, D1904 As Integer, DatumW As Long

    Dim LTagVorw As Date

    

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Activate"

    

    Z1 = 7 'erste DatenZeile

    

    'Bei Datumswert 1904 Aktivierung

    If ThisWorkbook.Date1904 Then D1904 = 1462

    

    LR = Cells(Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte A

    

    LTagVorw = Date - (Weekday(Date, vbMonday) - 1) - 2 ' Erster Tag der Woche - 2 Tage = Samstag Vorwoche

    

    DatumW = CLng(LTagVorw) - D1904

    

    Zeile = WorksheetFunction.CountIf(Columns(1), DatumW) 'Ist das Datum in Tabelle vorhanden

    If Zeile > 0 Then

        Zeile = WorksheetFunction.Match(DatumW, Columns(1), 0) ' Ja, in Zeile

        

        Rows(Z1).Resize(Zeile - Z1 + 1).Locked = True 'vorher sperren

        Rows(Zeile).Resize(LR - Zeile + 1).Locked = False 'Rest bis Ende ungesperrt

    End If

    

    Me.Protect Userinterfaceonly:=True 'Blatt schützen

    

    '*** 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

LG UweD

Hallo nochmal

"Bei Aktivierung des Blattes..."
Wenn du von einem anderen Blatt auf dieses wechselst...

Hab gerade noch gemerkt, wenn das Blatt schon geschützt ist, kommt noch ein Fehler.
Deshalb besser so (Blattschutz nach oben verschieben

Ausserdem, wenn du schon auf dem Blatt bist, startet der Code nicht.

Deshalb:

- Lösche den Code im Tabellenblatt wieder
- Füge das hier in deinem Modul1 unten an

Sub Zeilenschutz()

    Dim TB As Worksheet, Zeile As Long, Z1 As Integer, LR As Long, D1904 As Integer, DatumW As Long

    Dim LTagVorw As Date

    

    If MsgBox("Vorwoche so korrekt erfasst", vbYesNo + vbQuestion, "Zeilenschutz") = vbjes Then

        Set TB = Sheets("Mastermonat")

        TB.Activate

    

        Z1 = 7 'erste DatenZeile

        

        TB.Protect Userinterfaceonly:=True 'Blatt schützen, aber Änderungen durch Code zulassen

        

        'Bei Datumswert 1904 Aktivierung

        If ThisWorkbook.Date1904 Then D1904 = 1462

        

        LR = TB.Cells(TB.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte A

        

        LTagVorw = Date - (Weekday(Date, vbMonday) - 1) - 2 ' Erster Tag der Woche - 2 Tage = Samstag Vorwoche

        

        DatumW = CLng(LTagVorw) - D1904

        

        Zeile = WorksheetFunction.CountIf(TB.Columns(1), DatumW) 'Ist das Datum in Tabelle vorhanden

        If Zeile > 0 Then

            Zeile = WorksheetFunction.Match(DatumW, TB.Columns(1), 0) ' Ja, in Zeile

            

            TB.Rows(Z1).Resize(Zeile - Z1 + 1).Locked = True 'vorher sperren

            TB.Rows(Zeile).Resize(LR - Zeile + 1).Locked = False 'Rest bis Ende ungesperrt

        End If

    End If

End Sub

- Ausserdem das hier noch im Codebeich von "DieseArbeitsmappe"

Private Sub Workbook_Open()

    Call Zeilenschutz

End Sub

Jetzt wird das Makro beim Öffnen der Datei aufgerufen.

LG UweD

Forumthread: Zellen der Vorwoche sperren

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Zellen der Vorwoche sperren

Forumthread: Zellen der Vorwoche sperren

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread