Makro ausführen trotz Blattschutz

[Beltason]

Hallo Leute,

wieder mal ein Problem  

Wir haben eine Tabelle mit 3 Blättern! Frühschicht, Spätschicht und Zusammenfassung!
Auf Blatt 1 (Frühschicht gibt es ein Makro das sich über alle Blätter hinfortsetzt. Bisher war es so das diese Tabelle über Blattschutz gesperrt war um versehendliche Einträge und Formelüberschreibung zu vermeiden. Das funktioniert jetzt mit dem Makro nicht mehr. Ich google jetzt schon den ganzen Tag um eine Lösung zu finden, doch keine funktioniert. Es kommen Fehlermeldungen!

Ich hoffe das hier einer ist (Eigendlich ja immer ) der eine Lösung dafür parat hat. Es geht wohl nur über Code der die gesperrten Zellen kurz aus dem Blattschutz nimmt, während das Makro läuft. Schlauer bin ich bei google nicht fündig geworden.  

Danke für jede Hilfe!!

[Gast 123]

Hallo

kannst du uns den Code bitte mal hochladen und sagen welche Fehlermeldung da kommt. So ist das mehr ein Ratespiel. Am besten bei Fehler auf Debuggen klicken und schauen welche Code Zeile gelb markiert ist. Ohne genaue Angaben können wir nicht viel dazu sagen.

mfg Gast 123

[Beltason]

Hallo Danke für die schnelle Antwort!! :19: 

Wie es der Zufall will hat die letzte Lösung bei Tante Google zum Erfolg geführt!!!!!!!!!!!!!!!!!!!
Falls einer mal das gleiche Problem hat, hier die Lösung!!

Einfach vor dem Makro schreiben
ActiveSheet.Unprotect


Nach dem Makro das schreiben
ActiveSheet.protect

Speichern, Blattschutz setzen, Makro testen und alles funzt!!! :18:

Ich sehe diesen Beitrag hier als gelösst und fertig!!

[MisterBurns]

Hallo,

deine Lösung kannst du natürlich nehmen, allerdings ist sie nicht ideal. Bricht dein Code nämlich mittendrin ab, dann bleibt dein Blatt ungeschützt.
Verwende daher besser dieses Makro beim Öffnen der Mappe

Code:

Private Sub Workbook_Open()
Worksheets("Tabelle1").Protect Password:="Kennwort", UserInterfaceOnly:=True
End Sub

Durch UserInterfaceOnly:=True erlaubst du VBA, trotz Blattschutzes Änderungen am Tabellenblatt vorzunehmen. Und so verhinderst du oben beschriebenes Problem.

Außerdem gibt es beim Setzen des Blattschutzes verschiedene Optionen, die Änderungen trotz Blattschutzes erlauben. Dafür müsste man aber erstmal wissen, was dein Code eigentlich tut.

[Beltason]

Hallo Mister Burns, danke für den besseren Lösungsvorschlag!! Werde ich nachher mal Testen.

Ich habe eine andere Frage!

Kann man das Makro so anpassen, das man es nur 1x am Tag ausführen darf? In meiner Tabelle ist übrigens ein Tagesdatum drinne mit =HEUTE() Vieleicht darüber?

LG

[MisterBurns]

Kann man das Makro so anpassen, das man es nur 1x am Tag ausführen darf?

Dafür würde ich ein eigenes Tabellenblatt anlegen. Bei Ausführung des Makros soll als erstes das Tabellenblatt durchsucht werden, ob dort das heutige Datum schon vorhanden ist. Falls nicht, dann soll es in die erste freie Zeile von Spalte A das heutige Datum schreiben. Dann kann das eigentliche Makro ausgeführt werden.
Ist dagegen das heutige Datum bereits vorhanden, dann wird das Makro nicht ausgeführt.

Code:

Sub Datum()
Dim ws As Worksheet
Dim letzte As Long

Set ws = Worksheets("Datum")
letzte = ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(letzte, 1).Value = Date Then
   MsgBox "Makro wurde heute schon ausgeführt!"
Else
   ws.Cells(letzte + 1, 1) = Date
   Call DeinMakro      'DeinMakro muss ersetzt werden durch den Namen deines Makros
End If

End Sub

[Beltason]

Hallo Mister Burns,

vielen Dank für deine Hilfe.

Leider funktioniert das nicht. Ich habe das Makro in das Modul gepackt wo das andere Makro liegt. Beim Starten kommt aber folgende Fehlermeldung: Prozedur kann außerhalb nicht ausgeführt erden.

Was mache ich falsch?

[MisterBurns]

Zeig mal den kompletten Code, wie du ihn jetzt im Modul drinhast.

[Beltason]

Hallo gerne....

Der komplette code aus meinem Modul.

Code:

Sub continue()
CarryOn = MsgBox("Willst du diese Tabellen-Eingaben Resetten? Achtung! Alle Eingaben werden unwiderruflich gelöscht! ", vbYesNo, "ACHTUNG!!")
If CarryOn = vbYes Then
ActiveSheet.Unprotect
Sheets("zusammenfassung").Select
    Range("I68").Select
    Selection.Copy
    Range("J68").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K66").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("J68").Select
    Selection.NumberFormat = "#,##0.00 $"
    Selection.Font.Bold = True
    Range("K61").Select
    Sheets("Spatschicht").Select
    Range("J38:J47").Select
    Selection.ClearContents
    Range("H38:H41").Select
    Selection.ClearContents
    Range("J27:J32").Select
    Selection.ClearContents
    Range("H27:H32").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-15
    Range("J9:J23").Select
    Selection.ClearContents
    Range("H9:H20").Select
    Selection.ClearContents
    Range("H45:H47").Select
    Selection.ClearContents
    Sheets("Frühschicht").Select
    Range("J9:J23").Select
    Selection.ClearContents
    Range("J27:J32").Select
    Selection.ClearContents
    Range("H27:H32").Select
    Selection.ClearContents
    Range("K28").Select
    ActiveWindow.SmallScroll Down:=12
    Range("J38:J47").Select
    Selection.ClearContents
    Range("H38:H41").Select
    Selection.ClearContents
    Range("H45:H48").Select
    Selection.ClearContents
    Range("H9:H20").Select
    Selection.ClearContents
    Range("K39").Select
    Sheets("Zusammenfassung").Select
    Range("J68").Select
    Selection.Copy
    Sheets("Frühschicht").Select
    ActiveWindow.SmallScroll Down:=-21
    Range("J7").Select
    ActiveSheet.Paste
    Range("K13").Select
    ActiveSheet.Protect

End If
End Sub

[MisterBurns]

Das ist nicht der komplette Code, denn mein Code ist darin nicht enthalten. Wie soll ich so den Fehler finden?