Hallo zusammen,
ich habe ein Makro, dass von einem Vorlagenblatt eine Kopie erstellt. Dazu fragt es den Namen des neu zu erstellenden Blatts über eine InputBox ab, und fügt es an vorletzter Stelle in der Arbeitsmappe ein (und gibt eine Fehlermeldung, falls der Name schon existiert). Jetzt möchte ich auf dem neu erstellten Arbeitsblatt eine bestimmte Range von Zellen sperren, damit in diesen keine Eintragungen vorgenommen werden können. Mit meiner Lösung habe ich aber das Problem, dass ich gar keine Zellen anklicken kann oder Eintragungen vornehmen kann, weil "die Zellen auf einem schreibgeschützten Blatt" sind. Mir ist das unverständlich, weil ich ja nur eine bestimmte Range gesperrt habe.
Hier der Code:
Private Sub CommandButton1_Click()
If ThisWorkbook.ActiveSheet.Name <> "NeuesBlatt" Then
umsonst = MsgBox("Bitte nur die Vorlage kopieren", vbOKOnly + vbCritical, "Fehler")
Exit Sub
End If
newName = Application.InputBox(prompt:="NeueNummer", Type:=2)
If newName <> False Then
For Each meinObjekt In Worksheets
If meinObjekt.Name = newName Then
umsonst = MsgBox("Diese Nummmer gibt es schon", vbOKOnly + vbCritical, "Fehler")
Exit Sub
End If
Next
ThisWorkbook.Unprotect Password:="abc"
blattZahl = ThisWorkbook.Worksheets.Count - 1
ThisWorkbook.Worksheets("NeuesBlatt").Copy After:=ThisWorkbook.Worksheets(blattZahl)
blattZahl = blattZahl + 1
Worksheets(blattZahl).Name = newName
'Worksheets("lastChange").Copy After:=Sheets(Sheets.Count)
'Worksheets(Sheets.Count).Name = newName & "LastChange"
Worksheets(newName).Activate
ThisWorkbook.Worksheets(newName).Cells(4, 30) = newName
ThisWorkbook.Worksheets(newName).Cells(4, 30).Interior.ColorIndex = 0
ThisWorkbook.Worksheets(newName).Cells(5, 30) = Format(Now(), "dd.mm.yyyy")
ThisWorkbook.Worksheets(newName).Cells(5, 30).Interior.ColorIndex = 0
ActiveSheet.Shapes("CommandButton1").Delete
ActiveSheet.Range("A111:G114,A116:G123,I111:P129,R111:AC133").Locked = True
ActiveSheet.Protect "abc"
'ThisWorkbook.Protect Password:="abc", structure:=True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Sheets("lastChange").Cells(Target.Row, Target.Column) = Now()
If (Hour(Now()) >= 6 And Hour(Now()) < 14) Then
Target.Interior.Color = RGB(6, 206, 249)
ElseIf (Hour(Now()) >= 14 And Hour(Now()) < 22) Then
Target.Interior.Color = RGB(150, 200, 0)
Else
Target.Interior.Color = RGB(200, 150, 0)
End If
ThisWorkbook.Protect Password:="abc", structure:=True
End Sub
Kann mir jemand sagen wie ich das Problem lösen kann?
|