VB Excel2002 Makro Blattschutz + Zellen auswählbar lassen

W4r10rd

Well-known member
ID: 260440
L
17 Oktober 2006
437
60
Ich habe hier 2 Probleme mit einem selbstgeschriebenen Makro:
(Nr. 1 ist aus dem Code von Nr. 2)

1. Obwohl der Code vorige Woche noch lief, kommt jetzt nur noch "Laufzeitfehler '1004':
Die Locked-Eigenschaft des Range-Objektes kann nicht festgelegt werden."

Im Prinzip soll der Inhalt einer Tabelle gesperrt werden, nur 1 Spalte für Kommentare soll offen sein.
Keine Ahnung, wie ich das Problem sonst angehen soll bzw. wo der Fehler liegt. Wenn ich statt "Range("A1:K" & Range("A65536").End(xlUp).Row)" einen festen Wert nehme (auskommentierte, erste Zeile) kommt die gleiche Meldung.


ERLEDIGT: Mein Fehler, der Blattschutz des Quellarbeitsblatts war noch aktiviert:roll:
Obwohl ich schwören könnte, dass das vorige Woche funktioniert hat:ugly:
Problem Nr. 2 besteht leider immer noch...


Code:
Sub blattsperre()
    'Workbooks("Februar.xls").Sheets(1).Range("A1:K200").Locked = True
    Workbooks("Februar.xls").Sheets(1).Range("A1:K" & Range("A65536").End(xlUp).Row).Locked = True
    Workbooks("Februar.xls").Sheets(1).Range("J6:J" & Range("A65536").End(xlUp).Row).Locked = False
    Workbooks("Februar.xls").Sheets(1).Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
    
End Sub


2. Problem:

Aus einer Arbeitsmappe sollen per Makro einzelne Arbeitsblätter in eine neue Arbeitsmappe kopiert werden, eine Kommentarspalte freigegen und die restlichen Zellen gesperrt werden.

Soweit funktioniert auch alles, jedoch finde ich keine Möglichkeit, die Optionen "gesperrte Zellen auswählen erlauben" und "nicht gesperrte Zellen auswählen erlauben" per Makro zu setzen (aus irgendwelchen Gründen im Standart nicht aktiv), sodass der Benutzer trotzdem nicht an die freigegebenen Zellen kommt.

Die Aufzeichnungsfunktion liefert mir leider keine passenden Optionen, genau so die Excel "Hilfe".

Kennt jemand zufällig diese oder hat eine Idee, wie ich das Problem umgehen kann?

Edit: Der Code ist noch in der Entwicklung, dementsprechend teilweise umständlich geschrieben. Bei Bedarf kann ich noch eine aktuelle Fassung der Dateien hochladen.

Code:
Dim monat As String
    If Sheets(1).ob_01.Value Then monat = "Januar"
    [...]
    If Sheets(1).ob_12.Value Then monat = "Dezember"
    Windows.Application.Workbooks.Add ("c:\temp\vorlage.xls")
    ActiveWorkbook.SaveAs ("c:\temp\" & monat & ".xls")
    Windows.Application.Workbooks.Open ("c:\temp\quelle.xls")
    Workbooks("quelle.xls").Sheets("AL " & monat & " 00").Copy After:=Workbooks(monat & ".xls").Sheets(1)
    Workbooks("quelle.xls").Sheets("AL " & monat & " 01").Copy After:=Workbooks(monat & ".xls").Sheets(2)
    Workbooks("quelle.xls").Sheets("AL " & monat & " 02").Copy After:=Workbooks(monat & ".xls").Sheets(3)
    Application.DisplayAlerts = False
    Workbooks(monat & ".xls").Sheets(1).Delete
    Application.DisplayAlerts = True
    Workbooks(monat & ".xls").Save
    Workbooks(monat & ".xls").Sheets(1).Range("A1:K" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = True
    Workbooks(monat & ".xls").Sheets(1).Range("J6:K" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = False
    Workbooks(monat & ".xls").Sheets(1).Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True, AllowSorting:=True
    Workbooks(monat & ".xls").Sheets(2).Range("A1:K" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = True
    Workbooks(monat & ".xls").Sheets(2).Range("J6:J" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = False
    Workbooks(monat & ".xls").Sheets(2).Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
    Workbooks(monat & ".xls").Sheets(3).Range("A1:K" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = True
    Workbooks(monat & ".xls").Sheets(3).Range("J6:J" & Workbooks(monat & ".xls").Sheets(1).Range("A65536").End(xlUp).Row).Locked = False
    Workbooks(monat & ".xls").Sheets(3).Protect Password:="test", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True
 
Zuletzt bearbeitet: