Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Makro alle Blätter schützen mit optionen

Betrifft: VBA Makro alle Blätter schützen mit optionen von: Daniel
Geschrieben am: 03.08.2014 12:33:07

Hallo zusammen,

Ich habe ein Makro gefunden was schon fast alles macht was ich brauche, ich würde allerdings gerne zusätzlich noch definieren können was an Funktionen weiterhin erlaubt ist. Hier ist insbesondere der autofilter wichtig.

Ich habe schon probiert das in den code einzufügen, bekomme aber jedes mal die Fehlermeldung: Laufzeitfehler '438' Objekt unterstützt diese Eigenschaft nicht

Hier der VBA code von DumDum gefunden auf Office-Lösung.de:

Option Explicit 

Sub Schutz() 
    Dim i As Long 
    Dim p1 As String 
    Dim p2 As String 
    p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe") 
    p2 = InputBox("Bitte Passwort wiederholen!", "Passworteingabe") 
    
    If p1 = "" Or p2 = "" Then 
        MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!" 
        Exit Sub 
    End If 
    
    If p1 <> p2 Then 
        MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!" 
        Exit Sub 
    End If 
    
    For i = 1 To Sheets.Count 
        Sheets(i).Protect p1 
    Next i 
    MsgBox "alle Blätter wurden geschützt" 


End Sub 

Sub Aufheben() 
Dim i As Long 
Dim p1 As String 
Dim p2 As String 
p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe") 
    If p1 = "" Then 
        MsgBox "Kein Passwort eingegeben!" & vbLf & vbLf & "Blattschutz wird nicht nicht  _
aufgehoben!" 
        Exit Sub 
    End If 
    On Error GoTo fehler 
    For i = 1 To Sheets.Count 
        Sheets(i).Unprotect p1 
    Next i 
MsgBox "alle Blätter wurden entsperrt" 

fehler: 
    If Err Then MsgBox "Falsches Passwort" 
End Sub

Ich hoffe Ihr könnt mir weiterhelfen, am liebsten hätte ich eine Liste mit allen Optionen die ich dann im Code einzeln an und aus schalten kann. Währe super wenn Ihr auch noch definieren könntet welcher in der Liste was genau erlaubt.

Wenn Ihr auch noch erklären könntet warum der Fehler auftritt währe mein Tag perfekt ;-)

Schon mal im Voraus vielen Dank

  

Betrifft: du kannst das selber... von: Oberschlumpf
Geschrieben am: 03.08.2014 12:39:54

...mit dem Makrorecorder

Hi Daniel

1. Starte den Makrorecorder
2. Setz den Blattschutz für erst mal nur eine Tabelle mit allen Optionen, die du benötigst
Jetzt hast du schon mal den Code mit den Optionen, was erlaubt ist, was nicht erlaubt ist.
3. Nun kannst du noch ne For/Next-Schleife drum herum "basteln" (wie sie ja schon im Bsp-Code enthalten ist)

Sollte dir 3. nicht gelingen, zeig uns noch mal den durch 1. + 2. entstandenen Code.

Hilfts?

Ciao
Thorsten


  

Betrifft: AW: du kannst das selber... von: Daniel
Geschrieben am: 03.08.2014 13:26:57

Hallo Thorsten,

das mit dem Recorder war natürlich ne super idee :).

Leider klappt es immer noch nicht, habe den aufgezeichneten Code

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True

eingefügt:
Sub Schutz()
    Dim i As Long
    Dim p1 As String
    Dim p2 As String
    p1 = InputBox("Bitte Passwort eingeben!", "Passworteingabe")
    p2 = InputBox("Bitte Passwort wiederholen!", "Passworteingabe")
    
    If p1 = "" Or p2 = "" Then
        MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!"
        Exit Sub
    End If
    
    If p1 <> p2 Then
        MsgBox "Eingaben waren nicht korrekt!" & vbLf & vbLf & "Kein Blattschutz!"
        Exit Sub
    End If
    
    For i = 1 To Sheets.Count
        Sheets(i).Protect p1, DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
        Next i
    MsgBox "alle Blätter wurden geschützt"


End Sub

Aber nun bekomme ich den Fehler: '1004': Anwendungs- oder objektdefinierter Fehler


  

Betrifft: AW: du kannst das selber... von: Oberschlumpf
Geschrieben am: 03.08.2014 13:54:19

Hi Daniel

ich kann deinen Fehler mit dem gezeigten Code nicht reproduzieren.

Habe deinen Code kopiert und in ein allgemeines Modul einer neu erstellten Excel-Datei eingefügt - ohne irgdwelche Veränderungen im Code

Dann hab ich den Code gestartet.
Nach Eingabe eines Passwortes, Wiederholung desselben wurde der Code für alle Tabellenblätter erfolgreich durchgeführt.

Dann passt irgdwas anderes in deiner Datei nicht, in der du den Code verwendest.

Ciao
Thorsten


  

Betrifft: AW: du kannst das selber... von: Daniel
Geschrieben am: 03.08.2014 14:14:19

Habe den Code in der PERSONAL.XLSB, aber dass dürfte doch keinen Unterschied machen oder?


  

Betrifft: AW: du kannst das selber... von: Oberschlumpf
Geschrieben am: 03.08.2014 14:22:08

ich bin KEINE Maschine!
ich...erwarte...mit Hi oder Hallo oder ähnlich angesprochen zu werden - in jeder Nachricht

Hi Daniel

Ich kenn mich mit der PERSONAL.XLSB jetzt nicht so aus (ich nutze noch immer Excel 2003), vermute aber, dass alles, was in der PERSONAL.XLSB steht, als Standard für jede geöffnete Standard-Excel-Datei gilt.

Wen ich damit recht habe, würde nun in JEDER deiner Dateien für jedes Tabellenblatt der von dir definierte Blattschutz gesetzt werden - willst du das so?

Aber na ja, noch funzt es ja nicht. Und ich weiß leider nicht, woran es liegt.
Hmm...wenns stimmt, was ich oben vermute, wird es sich bei der Datei PERSONAL.XLSB um eine Vorlage und/oder AddIn handeln. Dateien dieser Art haben, so viel ich weiß, keine Tabellenblätter - du kannst nur VBA-Code erstellen, der NICHT auf die Methoden/Eigenschaften einer Tabelle zugreift.
Aber wie gesagt, ich weiß es nicht.

Ciao
Thorsten


  

Betrifft: AW: du kannst das selber... von: Daniel
Geschrieben am: 03.08.2014 14:38:42

Hallo Thorsten,

erst einmal sorry.

Also du hattest recht, ich habe das bei einer anderen Datei probiert und es geht einwandfrei auch mit dem code in der Personal.xlsb.

Wenn mich nicht alles Täuscht wird der code der Personal.xlsb nur im Aktiven Arbeitsblatt angewandt.

Das beste ist das mir gerade aufgefallen ist das das Makro auch in der Arbeitsmappe trotz der Fehlermeldung funktioniert. Und ohne die Definitionen was erlaubt ist lauft es ohne murren durch...

Gruss
Daniel


  

Betrifft: hab auch ne frage von: Spenski
Geschrieben am: 03.08.2014 16:01:50

hi ich nutze einfach mal den thread da es hier bisschen herpasst und ich nicht immer n neuen aufmachen will :)

Sub setzen()
Sheets(1).Protect
Sheets(2).Protect
Sheets(3).Protect
End Sub
Sub aufheben()
Sheets(1).Unprotect
Sheets(2).Unprotect
Sheets(3).Unprotect
End Sub
gibts auch n befehl um einfach alle tabellenblätter gleichzeitig zu schützen oder muss man jedes einzelne angeben?

gruss und sry für das wenig offtopic^^


  

Betrifft: AW: hab auch ne frage von: Oberschlumpf
Geschrieben am: 03.08.2014 16:13:53

Hi ???

Meines Wissens geht es nur so, wie du es zeigst, oder eben über eine Schleife mit Schleifenparameter.

Ciao
Thorsten


  

Betrifft: AW: hab auch ne frage von: Spenski
Geschrieben am: 03.08.2014 16:22:57

danke thorsten:)


 

Beiträge aus den Excel-Beispielen zum Thema "VBA Makro alle Blätter schützen mit optionen"