Tabellenschutz in Abhängigkeit des Zellenmusters

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Fritz!
Für das Aufheben des Blattschutzes bei der Eingabe, kann mein Code nicht
verantwortlich sein.
Das andere Problem kann man so umgehen.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Dim rng As Range, r As Range
Dim bCheck As Boolean

With Sh
  If TypeName(Sh) = "Worksheet" Then
    .Unprotect "XXX"

    On Error Resume Next
    Set rng = .UsedRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0

    If Not rng Is Nothing Then
      For Each r In rng
        On Error Resume Next
        bCheck = r.FormatConditions(1).Formula1 <> ""
        On Error GoTo 0
        If bCheck Then
          If Not r.Locked And r.Interior.ColorIndex = 36 And Len(r) > 0 Then
            r.Locked = True
          ElseIf r.Interior.ColorIndex = 36 And Len(r) = 0 Then
            r.Locked = False
          End If
        End If
      Next
    End If

    .Protect "XXX"
  End If
End With
End Sub

Gruß Sepp

Hallo Sepp,
dein Code funktioniert wie gewünscht. Herzlichen Dank!
Zu meinem zweiten Änderungswunsch. Wenn die Aufhebung des Blattschutzes nicht in deinem Code begründet ist, kann es nur der nachfolgende Code sein, den mir ein anderer hilfsbereiter Forumsbesucher vor einiger Zeit geschrieben hat und der sich im entsprechenden Tabellenblatt befindet.
Lässt sich mein Wunsch angesichts dieser Tatsache überhaupt noch realisieren?
Gruß
Fritz


Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="XXX"
Dim SuBe As Range, _
s As String
If Target.Address <> "$G$1" Then Exit Sub
s = Target.Text
Set SuBe = Range("H1:CU1").Find(What:=s, _
After:=Range("CU1"), LookAt:=xlWhole)
If Not SuBe Is Nothing Then
Application.EnableEvents = False       'Ereignis AUS
Range("CV1:CW50").Value = _
Range(Cells(1, SuBe.Column - 1), Cells(50, SuBe.Column)).Value
Application.EnableEvents = True        'Ereignis EIN
Set SuBe = Nothing
Else
MsgBox "Suchbegriff '" & s & "' nicht gefunden !", 64, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
ActiveSheet.Protect Password:="XXX"
End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenschutz in Abhängigkeit des Zellenmusters

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenschutz in Abhängigkeit des Zellenmusters

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread