Autor: Uwe Küstner  --- Aus Excel VBA - Gruppe: Häufige Fragen

Formelschutz ohne aktiven Blattschutz

Autor: Uwe Küstner - Erstellt: --      - Letzte Revision: --
Es gibt vielerlei Gründe, den Zell-/Blattschutz nicht zu aktivieren.

Sollen trotzdem Formeln vor dem Überschreiben geschützt werden, lassen sich mit folgendem Makro alle Änderungen in Zellen überwachen.
Wenn festgestellt wird, dass eine Formel überschrieben wurde, wird die ursprüngliche Formel der entsprechenden Zelle(n) wieder hergestellt.
Fügen Sie das Makro in das Modul 'DieseArbeitsmappe' ein. Mit dem 'Select Case'-Filter können Sie einstellen, welche Arbeitsblätter(Tabellen)
überwacht werden sollen.

Wichtig: Zum Ausschalten des Schutzes schalten Sie den Entwurfsmodus ein (unter Ansicht|Symbolleisten|Visual Basic).
Bedenken Sie auch, dass der Schutz bei ausgeschalteten Makros nicht greift.

Und eine Garantie, dass der Anwender nicht doch eine Möglichkeit findet, kann natürlich niemand geben.
Experimentieren Sie mit dem Vorschlag weiter! 



' **************************************************************
'  Modul:  DieseArbeitsmappe  Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
  'Zellen mit Formeln werden vor Überschreiben
  'geschützt, ohne den Blattschutz aktivieren zu müssen
  'Uwe Küstner
  Dim WertAktuell()
  Dim rngArea As Range
  Dim rngAZ As Range
  Dim rngZelle As Range
  Dim lngZ As Long
  Set rngAZ = ActiveCell
  On Error GoTo Ende
  Application.EnableEvents = False
  Select Case Sh.Name
    Case "Tabelle1", "Tabelle3"
      'die Formeln dieser Tabellen werden nicht geschützt
    Case Else
      'die Auswahl ließe sich durch das Entfernen von 'Case Else' umkehren
      ReDim WertAktuell(1 To Target.Cells.Count)
      For Each rngArea In Target.Areas
        For Each rngZelle In rngArea.Cells
          lngZ = lngZ + 1
          WertAktuell(lngZ) = rngZelle.Formula
        Next rngZelle
      Next rngArea
      lngZ = 0
      Application.Undo
      For Each rngArea In Target.Areas
        For Each rngZelle In rngArea.Cells
          lngZ = lngZ + 1
          If Not rngZelle.HasFormula Then rngZelle = WertAktuell(lngZ)
        Next rngZelle
      Next rngArea
      rngAZ.Activate
  End Select
Ende:
  Application.EnableEvents = True
End Sub

Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben
ToDo
Google Werbung