Blattschutz über VBA Code deaktivieren

Forumthread: Blattschutz über VBA Code deaktivieren

05.07.2024 09:14:22

Birgit2024

Hallo Forum,

Mit folgendem Code, soll eine neue Zeile nach der letzten belegten Zeile für das
anlegen eines neuen Mitarbeiters angefügt werden. Da das Tabellenblatt einen Blattschutz hat,
dachte ich mit ActiveSheet.Unprotect könnte ich es über den Code abschalten aber leider bekomme ich dann
einen Laufzeitfehler '1004' Die Zelle oder das Diagramm, die bzw. das Sie ändern möchten,
befindet sich auf einem schreibgeschützten Blatt. usw.
Im Code wird dann folgene Passage gelb hinterlegt.

.Cells(lngLetzte, 1).ClearContents

Sub neuer_mitarbeiter()

ActiveSheet.Unprotect "mein Passwort"

If MsgBox("möchten Sie einen neuen Mitarbeiter hinzufügen?", vbYesNo) = vbYes Then

  Dim lngLetzte As Long

  With Worksheets("Planer")

     lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row

     .Rows(lngLetzte).Copy Cells(lngLetzte + 1, 1)

     lngLetzte = Range("A65536").End(xlUp).Row

     .Rows(lngLetzte).Select

     .Cells(lngLetzte, 1).ClearContents

  End With

 Else

 MsgBox "Eingabe wurden abgebrochen!"

End If

ActiveSheet.Protect "mein Passwort"

End Sub

Besten Dank im Voraus
Birgit

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Blattschutz über VBA Code deaktivieren

05.07.2024 09:37:06

t1ger1801

Also ich würde erst einmal schauen, dass das richtige Blatt aktiv ist. Dann würde ich auch immer die vollständigen Referenzen nutzen. Du solltest auch vor dem Blattschutz überprüfen, ob das Blatt bereits ungeschützt ist.
Hier mal ein Vorschlag. Teste das mal:

Sub neuer_mitarbeiter()

    Dim ws As Worksheet

    Set ws = Worksheets("Planer")



    ' Blattschutz aufheben

    ws.Unprotect "mein Passwort"

    

    ' Überprüfen, ob der Benutzer einen neuen Mitarbeiter hinzufügen möchte

    If MsgBox("Möchten Sie einen neuen Mitarbeiter hinzufügen?", vbYesNo) = vbYes Then

        Dim lngLetzte As Long

        

        With ws

            ' Letzte belegte Zeile in Spalte A finden

            lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row

            

            ' Neue Zeile durch Kopieren der letzten Zeile hinzufügen

            .Rows(lngLetzte).Copy .Cells(lngLetzte + 1, 1)

            

            ' Letzte belegte Zeile in Spalte A erneut finden

            lngLetzte = .Range("A" & .Rows.Count).End(xlUp).Row

            

            ' Neue Zeile auswählen und den Inhalt der ersten Zelle löschen

            .Rows(lngLetzte).Select

            .Cells(lngLetzte, 1).ClearContents

        End With

    Else

        MsgBox "Eingabe wurde abgebrochen!"

    End If



    ' Blattschutz wieder aktivieren

    ws.Protect "mein Passwort"

End Sub

AW: Blattschutz über VBA Code deaktivieren

05.07.2024 09:37:50

MCO

Hallo Birgit!

du entsperrst "Activesheet" und hast aber with Worksheets ("Planer")
Warum steht das nicht auch in der with-Bedingung? oder gehört es da wirklich nicht rein?

Wir kennen deine Tabelle nicht, aber hier fehlt der Verweis (der Punkt vor CELLS):

  With Worksheets("Planer")

     lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row

Gleiches hier

.Rows(lngLetzte).Copy Cells(lngLetzte + 1, 1)

und hier

lngLetzte = Range("A65536").End(xlUp).Row

Dann leitest du die letzte Zeile 2x her (was erstmal richtig ist, da sie sich ja ändert) aber auf verschiedene Weise. Warum?
Oder mach es einfacher:

     lngLetzte =      lngLetzte +1

Außerdem würde ich nicht schon was entsperren, obwohl keine Eingabe gemacht werden könnte...

Alles in allem sieht es dann wohl so aus:

Sub neuer_mitarbeiter()

    Dim lngLetzte As Long



    If MsgBox("möchten Sie einen neuen Mitarbeiter hinzufügen?", vbYesNo) = vbYes Then

        With Worksheets("Planer")

            .Unprotect "mein Passwort"

      

            lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row

            .Rows(lngLetzte).Copy .Cells(lngLetzte + 1, 1)

            lngLetzte = lngLetzte + 1

            .Rows(lngLetzte).Select

            .Cells(lngLetzte, 1).ClearContents

            .Protect "mein Passwort"

        End With

    Else

        MsgBox "Eingabe wurden abgebrochen!"

    End If

End Sub

Gruß, MCO

AW: Blattschutz über VBA Code deaktivieren

05.07.2024 10:45:54

Birgit2024

Hallo zusammen,

leider bekomme ich bei eueren Vorschlägen die selbe Fehlermeldung.
Ich habe die Datei mal zum testen hochgeladen, eventuell liegt der Fehler ja an anderer Stelle.

https://www.herber.de/bbs/user/170717.zip

Besten Dank im Voraus
Birgit

AW: Blattschutz über VBA Code deaktivieren

05.07.2024 13:20:55

MCO

Hi!

Bei mir läuft es so sauber durch. Vorher aber auch.
(Macht es denn Sinn, einen neuen MA anzulegen und das Blatt zu sperren, ohne dass Daten eingetragen sind?)

Sub neuer_mitarbeiter()

    Dim ws As Worksheet

    Dim lngLetzte As Long

    

    Set ws = Worksheets("Planer")

    ' Überprüfen, ob der Benutzer einen neuen Mitarbeiter hinzufügen möchte

    If MsgBox("Möchten Sie einen neuen Mitarbeiter hinzufügen?", vbYesNo) = vbYes Then

        With ws

            .Unprotect "test24" ' Blattschutz aufheben

            lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row ' Letzte belegte Zeile in Spalte A finden

            .Rows(lngLetzte).Copy .Cells(lngLetzte + 1, 1) ' Neue Zeile durch Kopieren der letzten Zeile hinzufügen

            lngLetzte = .Range("A" & .Rows.Count).End(xlUp).Row ' Letzte belegte Zeile in Spalte A erneut finden

            .Rows(lngLetzte).Select ' Neue Zeile auswählen und den Inhalt der ersten Zelle löschen

            .Cells(lngLetzte, 1).ClearContents

            .Protect "test24" ' Blattschutz wieder aktivieren

        End With

    Else

        MsgBox "Eingabe wurde abgebrochen!"

    End If

End Sub

Viel Erfolg noch.
Gruß, MCO

Beliebteste Forumthreads (12 Monate)

Blattschutz über VBA Code deaktivieren

Forumthread: Blattschutz über VBA Code deaktivieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread