HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Nächster Thread

Vorwärts blättern

Inhaltsverzeichnis

Blattschutz automatisch sperren

Forumthread: Blattschutz automatisch sperren
21 Beiträge zu diesem Forumthread
Anzeige
Threads zu ähnlichen Themen

Forumthread: Blattschutz automatisch sperren

31.03.2025 16:09:00

Andreas

Ein Hallo in die Runde

Meine VBA Kenntnisse sind eher bescheiden oder nicht vorhanden, deshalb meine Frage.

Ich habe eine Anwesenheitstabelle, also für jeden Monat ein Tabellenblatt. Die Zellen, die durch die Mitarbeiter ausgefühlt werden, sind offen und alles andere ist mit einem Blattschutz versehen.

Wenn der Monat nun vorbei ist sollen (nach 12 Tagen) die nicht geschützten Zellen automatisch gesperrt werden.

Nun meine Frage: lässt sich so etwas mit VBA bewerkstelligen. Kann mir bitte jemand helfen.
Danke im Voraus
Andreas

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Blattschutz automatisch sperren

31.03.2025 16:33:36

Andreas
AW: Blattschutz automatisch sperren

31.03.2025 16:43:36

UweD
AW: Blattschutz automatisch sperren

31.03.2025 16:34:43

velo
Nachtrag

31.03.2025 16:57:51

velo
AW: Blattschutz automatisch sperren

31.03.2025 16:59:10

Andreas
AW: Blattschutz automatisch sperren

31.03.2025 17:24:03

velo
AW: Blattschutz automatisch sperren

31.03.2025 17:55:59

Oberschlumpf
AW: Blattschutz automatisch sperren

31.03.2025 23:30:10

Andreas
AW: Blattschutz automatisch sperren

31.03.2025 23:38:01

Oberschlumpf
AW: Blattschutz automatisch sperren

01.04.2025 09:36:55

Andreas
AW: Blattschutz automatisch sperren

01.04.2025 09:46:51

Oberschlumpf
AW: Blattschutz automatisch sperren

31.03.2025 16:37:58

mumpel
AW: Blattschutz automatisch sperren

31.03.2025 16:41:28

cysu11
AW: Blattschutz automatisch sperren

31.03.2025 16:46:31

cysu11
AW: Blattschutz automatisch sperren

01.04.2025 10:50:13

Andreas
falsches Passwort?

01.04.2025 13:05:55

velo
AW: Blattschutz automatisch sperren

01.04.2025 18:10:20

cysu11
AW: Blattschutz automatisch sperren

01.04.2025 18:16:06

UweD
AW: Blattschutz automatisch sperren

02.04.2025 17:32:18

Andreas
AW: Blattschutz automatisch sperren

02.04.2025 19:07:39

GerdL
AW: falsches Passwort?

01.04.2025 13:52:27

Andreas

AW: Blattschutz automatisch sperren

31.03.2025 16:33:36

Andreas

AW: Blattschutz automatisch sperren

31.03.2025 16:43:36

UweD

Hallo

Annahme Blattname Feb 2025 oder 02.2025 oder ...

- Code muss in DieseArbeitsmappe

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    Dim Grenzdatum As Date

    

    'angenommen Blattname ist Feb 2025 oder 02.2025 oder Februar 2025

    

    If IsDate(Sh.Name) Then

        Grenzdatum = WorksheetFunction.EoMonth(DateValue("1." & Sh.Name), 0) + 12

        

        If Date > Grenzdatum Then

            With Sh

                .Unprotect

                .Cells.Locked = True

                .Protect

            End With

        End If

    End If

End Sub

LG UweD

AW: Blattschutz automatisch sperren

31.03.2025 16:34:43

velo

Hallo,

probiers mal mit folgendem Code, hier werden die Zellen 12 Tage nach Monatsende wieder gesperrt:

Option Explicit



Private Sub Workbook_Open()

    Dim ws As Worksheet

    Dim Monate As Object

    Set Monate = CreateObject("Scripting.Dictionary")

    

    Monate.Add "Jan", 1

    Monate.Add "Feb", 2

    Monate.Add "Mrz", 3

    Monate.Add "Apr", 4

    Monate.Add "Mai", 5

    Monate.Add "Jun", 6

    Monate.Add "Jul", 7

    Monate.Add "Aug", 8

    Monate.Add "Sep", 9

    Monate.Add "Okt", 10

    Monate.Add "Nov", 11

    Monate.Add "Dez", 12

    

    For Each ws In ThisWorkbook.Worksheets

        If Date >= DateSerial(Year(Date), Monate(ws.Name) + 1, 0) + 12 Then

            ws.Cells.Locked = True

        End If

    Next ws

End Sub

Achtung: Du musst den Code in DieseArbeitsmappe und nicht in ein Modul einfügen:
Userbild

Und natürlich die Dictionary Keys ändern wenn du die Monate ausgeschrieben hast --> "Jan" wird zu "Januar" usw.

VG
velo

Nachtrag

31.03.2025 16:57:51

velo

Kleiner Nachtrag, man muss den Arbeitsblattschutz noch aufheben, bevor man die Zellen sperrt.

Das ganze sieht dann so aus:

Option Explicit



Private Sub Workbook_Open()

    Dim ws As Worksheet

    Dim Monate As Object

    Set Monate = CreateObject("Scripting.Dictionary")

    

    Monate.Add "Jan", 1

    Monate.Add "Feb", 2

    Monate.Add "Mrz", 3

    Monate.Add "Apr", 4

    Monate.Add "Mai", 5

    Monate.Add "Jun", 6

    Monate.Add "Jul", 7

    Monate.Add "Aug", 8

    Monate.Add "Sep", 9

    Monate.Add "Okt", 10

    Monate.Add "Nov", 11

    Monate.Add "Dez", 12

    

    For Each ws In ThisWorkbook.Worksheets

        If Date >= DateSerial(Year(Date), Monate(ws.Name) + 1, 0) + 12 Then

            ws.Unprotect "DeinPasswort" 'hier durch dein Passwort ersetzen, falls gegeben. Wenn kein Passwort vergeben, dann komplett weg

            ws.Cells.Locked = True

            ws.Protect "DeinPasswort" 's.o.

        End If

    Next ws

End Sub

AW: Blattschutz automatisch sperren

31.03.2025 16:59:10

Andreas

Hallo velo,
danke für die schnelle antwort. Aber ich bekomme eine Fehlermeldung

Userbild

AW: Blattschutz automatisch sperren

31.03.2025 17:24:03

velo

Hallo Andreas,

siehe meinen Nachtrag: https://www.herber.de/forum/messages/2009952.html

Mit dem Code vom Nachtrag müsste der Fehler behoben sein.

VG
velo

AW: Blattschutz automatisch sperren

31.03.2025 17:55:59

Oberschlumpf

grrrrr Andreas!!!

Was soll das????
Verrätst du uns auch bitte, WELCHE Fehlermeldung du erhältst????
Sorry, wenn ich so ungehalten wirke - aber ich ärgere mich gerad echt über dein nicht-Mitdenken!
Bitte wie, glaubst du, soll uns dein Hinweis "du erhältst Fehlermeldung" helfen, wenn du uns nich verrätst, was genau für ein Fehler es ist???
Vllt ist deine Frage schon beantwortet; ich hab noch nich alle Beiträge gelesen - als ich aber den Beitrag von dir las, auf den ich gerade antworte - war mein Puls hochgeschnellt.

Ciao
Thorsten

AW: Blattschutz automatisch sperren

31.03.2025 23:30:10

Andreas

Hallo Thorsten,
ich hatte extra ein Bild mit angehängt um die Fehlermeldung eindeutig zu dokumentieren.

Sorry

AW: Blattschutz automatisch sperren

31.03.2025 23:38:01

Oberschlumpf

hä Andreas?

ich sehe nur 1 Bild, in dem man sehen kann, welche Codezeile einen Fehler verursacht - aber die Fehlermeldung selbst sehe ich nicht!

Ciao

AW: Blattschutz automatisch sperren

01.04.2025 09:36:55

Andreas

Hallo Thorsten,

enschuldige aber ich bin noch ein wenig unerfahren. Hier die Fehlermeldung.
Userbild

AW: Blattschutz automatisch sperren

01.04.2025 09:46:51

Oberschlumpf

Ja, danke Andreas.

Hast du denn schon die Ideen der anderen Antworter ausprobiert?
Ja? Dann solltest du ihnen auch antworten.

Ciao
Thorsten

AW: Blattschutz automatisch sperren

31.03.2025 16:37:58

mumpel

Hallo!

Die Zellen generell sperren. Die Liste wird dann per Userform befüllt.

Gruß, René

AW: Blattschutz automatisch sperren

31.03.2025 16:41:28

cysu11

Hi Andreas,

oder so:

Private Sub Workbook_Open()

Dim ws As Worksheet, lastday As Date, today As Date, firstday As Date

today = Date

For Each ws In ThisWorkbook.Sheets

    firstday = ws.Cells(1, 1)

    lastday = DateSerial(Year(firstday), Month(firstday) + 1, 0)

    If today > lastday + 12 Then

        ws.Unprotect

        ws.Cells.Locked = True

        ws.Protect

    End If

Next ws

End Sub

In das Modul der Arbeitsmappe, wie von Velo schon beschrieben.

LG, Alexandra

AW: Blattschutz automatisch sperren

31.03.2025 16:46:31

cysu11

ich bin davon ausgegangen, dass das Anfangsdatum eines Monats immer in A1 ist, bei Bedarf natürlich anpassen! LG, Alexandra

AW: Blattschutz automatisch sperren

01.04.2025 10:50:13

Andreas

Hallo Alexandra,

danke für Deine Antwort. Aber wie schon bei Thorsten gibt es immer die Fehlermeldung, dass das Kennwort falsch ist. Es gibt auch ein Tabellenblatt mit einem anderen Kennwort (es arbeiten zwei Personen an der Datei).
Ich habe auch nicht mehr die Möglichkeit den Blattschutz aufzuheben, weil mein Kennwort nicht mehr funktioniert.

Grüße Andreas

falsches Passwort?

01.04.2025 13:05:55

velo

Hallo Andreas,

kann es sein, dass du schlicht ein falsches Kennwort eingibst und nicht dass es einfach nicht mehr funktioniert?
Nichtsdestotrotz würde ich die Passwörter für alle Arbeitsblätter vereinheitlichen, damit das Makro auch einfach über jedes Arbeitsblatt "drüberfahren" kann.

Wenn du aber dein Kennwort nicht mehr weißt, denke ich bleibt dir nichts anderes über als die Datei neu aufzubauen.

VG
velo

AW: Blattschutz automatisch sperren

01.04.2025 18:10:20

cysu11

Hallo Andreas,

mein Code macht genau das was du willst. Wenn du das oder die Kennwörter nicht mehr weiß, dann, kann ich auch nicht helfen. Wenn es verschieden Kennwörter gibt und du diese weißt, dann kann man das auch per Code regeln. Am besten eine Beispieldatei hochladen, dann tun wir uns alle einfacher! :)

LG, Alexadra

AW: Blattschutz automatisch sperren

01.04.2025 18:16:06

UweD

Dann google doch mal, wie man ein Blattschutz Passwort entfernt, ohne Es zu kennen.

LG UweD

AW: Blattschutz automatisch sperren

02.04.2025 17:32:18

Andreas

Private Sub Workbook_Open()

Dim ws As Worksheet, lastday As Date, today As Date, firstday As Date

today = Date

Dim Monate As Object

    Set Monate = CreateObject("Scripting.Dictionary")



    Monate.Add "Jan", 1

    Monate.Add "Feb", 5

    Monate.Add "Mrz", 6

    Monate.Add "Apr", 7

    Monate.Add "Mai", 8

    Monate.Add "Jun", 9

    Monate.Add "Jul", 10

    Monate.Add "Aug", 11

    Monate.Add "Sep", 12

    Monate.Add "Okt", 13

    Monate.Add "Nov", 14

    Monate.Add "Dez", 15

    

For Each ws In ThisWorkbook.Sheets

    firstday = ws.Cells(36, 1)

    lastday = DateSerial(Year(firstday), Month(firstday) + 1, 0)

    If today > lastday + 12 Then

        ws.Unprotect (8154711)

        ws.Cells.Locked = True

        ws.Protect (8154711)

    End If

Next ws

End Sub

Hallo Alexandra, liebe Excel- Gemeinschaft,

ich habe das Problem jetzt lösen können und nur durch eure Tipps und Ratschläge. Ich bin euch so dankbar und habe glaube eine neue Herausforderung gefunden.
Danke an alle
Andreas

AW: Blattschutz automatisch sperren

02.04.2025 19:07:39

GerdL

Moin Andreas,

ein kleiner Ergänzungsvorschlag.



'.........................................

For Each ws In ThisWorkbook.Sheets

   If Not ws.Locked = True Then

    firstday = ws.Cells(36, 1)

    lastday = DateSerial(Year(firstday), Month(firstday) + 1, 0)

    If today > lastday + 12 Then

       ws.Unprotect (8154711)

        ws.Cells.Locked = True

        ws.Protect (8154711)

    End If

   End If

Next ws

'..................................

Gruß Gerd

AW: falsches Passwort?

01.04.2025 13:52:27

Andreas

Hallo velo,

ich habe zur Sicherheit eine Kopie angelegt, wenn nichts mehr geht 😉

Zum besseren Verstäntniss habe ich ein Tabellenblatt mal hochgeladen. Die Zellen die blau hinterlegt sind werden von den Mitarbeitern ausgefühlt und alles andere ist mit einem Blattschutz versehen um die Formeln zu schützen. Wenn nun der Monat zu ende ist soll nach 12 Tagen die nicht geschützen Zellen gespert werden.
Das war die Idee.

Grüße Andreas

Userbild