|
klassisch lt. Handbuch
Option Explicit
Sub Test_BeforeSave()
Dim wsTab As Worksheet
Dim rngWerte As Range
Dim rngFormeln As Range
Set wsTab = Worksheets("Korrekturen")
On Error Resume Next
With wsTab
If .ProtectContents = True Then .Unprotect Password:="record"
With .Range("A:X")
.Locked = False
On Error Resume Next
Set rngWerte = .SpecialCells(xlCellTypeConstants)
Set rngFormeln = .SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
End With
If Not rngWerte Is Nothing Then rngWerte.Locked = True
If Not rngFormeln Is Nothing Then rngFormeln.Locked = True
'Beispiel Volltext
Ausnahmen wsTab, 12, "a", xlWhole
Ausnahmen wsTab, 23, "s", xlWhole
'Beispiel im Text vorhanden
Ausnahmen wsTab, 12, "s", xlPart
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="record"
End With
End Sub
Private Sub Ausnahmen(Blatt As Worksheet, Spalte As Long, Suche As String, Wie As Long)
Dim c As Range, fa As String
With Blatt.Columns(Spalte)
Set c = .Find(Suche, LookIn:=xlValues, LookAt:=Wie)
If Not c Is Nothing Then
fa = c.Address
Do
c.Locked = False
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
End With
End Sub
|