Microsoft Excel

Herbers Excel/VBA-Archiv

VBA Blattschutz und Aufheben alle Blätter


Betrifft: VBA Blattschutz und Aufheben alle Blätter
von: Joachim
Geschrieben am: 29.11.2018 14:20:17

Hallo zusammen,

ich möchte alle Blätter der Datei schützen bzw. den Schutz aufheben.

Ist es möglich, mit einem Eintrag in Zelle A100 der "BSE" lautet den Blatschutz für alle Blätter gleichzeitig einzustellen ?

und mit einem Eintrag in B100 der "BSA" lauten soll, den Blattschutz für alle Bläter gleichzeig aufzuheben ?
Immer nur ein Eintrag entweder oder ist erlaubt und beim Schließen der Mappe sollte der Blattschutz immer eingesetzt werden.

Das Passwort erstmal auf "ABC" einstellen.

Ein VBA-Code (ich kann es nicht) wäre schön und nett.

Lieben Dank den Helfern

  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: Rudi Maintaire
Geschrieben am: 29.11.2018 14:35:43

Hallo,
im Klassenmodul des Blatts mit BSA/ BSE:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count = 1 Then
    If Target.Column = 100 Then
      Select Case Target.Column
        Case 1: If Target = "BSE" Then Call ProtectSheets(pstrPW )
        Case 2: If Target = "BSA" Then Call UnProtectSheets(pstrPW )
      End Select
    End If
  End If
End Sub

In DieseArbeitsmappe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call ProtectSheets(pstrPW )
End Sub

In ein allgem. Modul:
Public Const pstrPW As String="ABC"
Sub ProtectSheets(strPW As String)
  Dim wks As Worksheet
  For Each wks In Worksheets
    wks.Protect strPW
  Next
End Sub

Sub UnProtectSheets(strPW As String)
  Dim wks As Worksheet
  For Each wks In Worksheets
    wks.Unprotect strPW
  Next
End Sub

Gruß
Rudi


  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: Joachim
Geschrieben am: 29.11.2018 14:47:36

Ok, ich werde es einarbeiten und es klappt dann hoffentlich, ansonsten geben ich hier Rückmeldung. Danke erstmal


  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: Joachim
Geschrieben am: 29.11.2018 14:59:28

Ok, habe ich eingearbeitet. Beim Schließen wird der Schutz eingestellt.

Bekomme es aber nicht hin, dass bei allen Blättern auf einen Schlag, der Blattschutz wieder aufgehoben wird.

Wie muss der Code geändert werden, wenn die Einträge nur im Blatt "Grunddaten" erlaubt sein soll ?


  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: PeterK
Geschrieben am: 29.11.2018 15:15:47

Hallo

Ändere If Target.Column = 100 Then in If Target.Row = 100 Then

Die Sub Worksheet_Change in das entsprechende Blatt mit den BSE/BSA Eingaben


  

Betrifft: oh,oh :( owT
von: Rudi Maintaire
Geschrieben am: 29.11.2018 15:17:42




  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: Joachim
Geschrieben am: 29.11.2018 15:33:11

Ich habe schon ein Worksheet_Change in dem Blatt. Muss ich was umbenennen ?


  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: PeterK
Geschrieben am: 29.11.2018 15:36:40

Hallo

Nur den Code zum Bestehenden hinzufügen (keine eigene Sub)


  

Betrifft: AW: VBA Blattschutz und Aufheben alle Blätter
von: Joachim
Geschrieben am: 29.11.2018 15:43:06

So ?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ze As Long, Ra As Range: For Each Ra In Target: Ze = 0
    If Ra.Column = 8 Or Ra.Column = 12 Then
      If Ra.Row > 6 And Ra.Offset(0, 2 - Ra.Column).FormulaR1C1 = "=RC[-1]" Then
        Ra.Offset(0, 1).ClearContents: Ra.Offset(0, 2).ClearContents
        With Worksheets(2).Range("IdxKür"): While .Offset(Ze + 1, 0) <> ""
          Ze = Ze + 1: If UCase(Ra.Value) = UCase(.Offset(Ze, 0)) Then Ra.Offset(0, 1) = . _
Offset(Ze, 1): Ra.Offset(0, 2) = .Offset(Ze, 2)
        Wend: End With
      End If
    End If: Next
    
  End Sub

If Target.Count = 1 Then
If Target.Row = 100 Then
Select Case Target.Column
Case 1: If Target = "BSE" Then Call ProtectSheets(pstrPW)
Case 2: If Target = "BSA" Then Call UnProtectSheets(pstrPW)
End Select
End If
End If
End Sub


  

Betrifft: AW: VBA Blattschutz etc. ich habs, läuft !!!
von: Joachim
Geschrieben am: 29.11.2018 16:23:23

Danke für die Hilfe und noch eine kleine Frage, kann das Klassenmodul jetzt weg ?