Zellen nach Eingabe sperren

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim zelle As Range Sheets("September").Unprotect For Each zelle In Sheets("September").UsedRange If zelle.Value "" Then zelle.Locked = True Else zelle.Locked = False End If Next Sheets("September").Protect End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Frank,
probier mal.

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

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim intIndex As Integer, rng As Range, objSh As Worksheet

  On Error Resume Next

  For intIndex = 1 To 12
    Set objSh = Sheets(Format(DateSerial(1, intIndex, 1), "MMMM"))
    If Not objSh Is Nothing Then
      With objSh
        .Unprotect
        Set rng = .Cells
        rng.Locked = False
        Set rng = .UsedRange.SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then rng.Locked = True
        Set rng = .UsedRange.SpecialCells(xlCellTypeConstants)
        If Not rng Is Nothing Then rng.Locked = True
        .Protect
      End With
      Set objSh = Nothing
    End If
  Next

  On Error GoTo 0

  Set rng = Nothing

End Sub

Gruß Sepp

Hallo Frank,
dann halt so.

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

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim intIndex As Integer, rng As Range, objSh As Worksheet

  On Error Resume Next

  For intIndex = 1 To 12
    Set objSh = Sheets(Format(DateSerial(1, intIndex, 1), "MMMM"))
    If Not objSh Is Nothing Then
      With objSh
        .Unprotect
        Set rng = .Range("A1:I40")
        rng.Locked = False
        Set rng = .Range("A1:I40").SpecialCells(xlCellTypeFormulas)
        If Not rng Is Nothing Then rng.Locked = True
        Set rng = .Range("A1:I40").SpecialCells(xlCellTypeConstants)
        If Not rng Is Nothing Then rng.Locked = True
        .Protect
      End With
      Set objSh = Nothing
    End If
  Next

  On Error GoTo 0

  Set rng = Nothing

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen nach Eingabe sperren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread