AW: VBA-Problem Zellen Sperren
18.11.2008 12:15:31
fcs
Hallo Daniel,
ich musste die Prozedur nochmals anpassen, damit Sperren von Zellen aufgehoben werden, wenn Wert in Spalte E
Damit die Prozeduren im Verbund funktionieren muss du in den Prozeduren, die per Button gestartet werden noche den Blattschutz aufheben bzw. setzen.
Die Prozeduren, in denen du die Prozedur "ZeilenPruefen" aufrufst scheinen OK zu sein.
Gruß
Franz
Private Sub ZeilenPruefen()
Dim Zeile As Long, wksSL As Worksheet, arrSperren As Variant
Dim Spalte As Long, SpalteSperr As Long, Anz As Long
Dim bolSperren As Boolean
Const Zeile1 As Long = 21 '1. Datenzeile
Set wksSL = Worksheets("Stahlliste")
With wksSL
Anz = .Range("E7").Value + 20 '=letzte zeile mit Positionsnummer
'Zeilen ab Zeile 21 bis zur letzten Positionsnummer abarbeiten
.Unprotect 'Blattschutz aufheben
For Zeile = Zeile1 To Anz
'Prüfen, ob Werte in Spalte E >0
If .Cells(Zeile, 5).Value > 0 Then
'Prüfen der Werte Spalte J und setzen des Arrays mit den zu sperrenden Spalten
Select Case .Cells(Zeile, 10).Value
Case 0
arrSperren = Array(14, 15, 16, 17, 18) 'b, c, d, e und R
Case 11, 15
arrSperren = Array(15, 16, 17, 18) 'c, d, e und R
Case 12
arrSperren = Array(15, 16, 17) 'c, d und e
Case 13, 21, 25, 26
arrSperren = Array(16, 17, 18) 'd, e und R
Case 31
arrSperren = Array(17, 18) 'e und R
Case 33
arrSperren = Array(16, 17) 'd, e
Case 41, 44
arrSperren = Array(18) 'R
Case 46
arrSperren = Array(16, 18) 'd und R
Case Else
arrSperren = Array(999) 'nichts sperren
End Select
For Spalte = 1 To 21 'Spalte A bis U ggf. sperren gemaß oben ermitteltem Array
Select Case Spalte
Case 5, 8 To 9, 20
'Spalten sind permanent geschützt
.Cells(Zeile, Spalte).Locked = True
Case 14, 15, 16, 17, 18, 999 '999 ist DummyWert, dass keine Spalten gesperrt werden
'diese sind die ggf. zu sperrenden Spalten
bolSperren = False
'Spaltennummer mit den zu sperrenden Spalten vergleichen
For SpalteSperr = LBound(arrSperren) To UBound(arrSperren)
If Spalte = arrSperren(SpalteSperr) Then
bolSperren = True
Exit For
End If
Next
If bolSperren = True Then
.Cells(Zeile, Spalte).Locked = True
Else
.Cells(Zeile, Spalte).Locked = False
End If
Case Else
'alle übrigen Eingabespalten nicht sperren
.Cells(Zeile, Spalte).Locked = False
End Select
Next
Else
For Spalte = 1 To 21 'Spalte A bis U entsperren bis auf Formelspalten
Select Case Spalte
Case 5, 8 To 9, 20
'Spalten sind permanent geschützt
.Cells(Zeile, Spalte).Locked = True
Case Else
'alle übrigen Eingabespalten nicht sperren
.Cells(Zeile, Spalte).Locked = False
End Select
Next
End If
Next
.Protect 'Blattschutz setzen
End With
End Sub
Private Sub Positionen_generieren()
Dim i As Integer
Worksheets("Stahlliste").Unprotect
Call ZeilenSpalten_generieren
Range("A16:U20").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Call Spalten_mit_Formeln_formatieren
'Call Formelzellen_sperren
Worksheets("Stahlliste").Protect
Call ZeilenPruefen
Call Eingabeaufforderung
End Sub
Sub Berechnen()
Dim Anz, k, Ergebnis As Double
Application.ScreenUpdating = False
Worksheets("Stahlliste").Unprotect
Call Berechnen_Spalte_E
Call Berechnen_Spalte_H
Call Berechnen_Spalte_I
Call Berechnen_Spalte_T
Worksheets("Stahlliste").Protect
Application.ScreenUpdating = True
Call ZeilenPruefen
End Sub