AW: Geschützte Tabelle
08.12.2010 14:15:39
fcs
Hallo Hans,
die folgenden Makros markieren oder selektieren (abhängig von gewählten Blattschutzeinstellungen) die ungeschützten Zellen.
Wichtig wenn Farbmarkierung gesetzt wird: Markierung vor dem schliessen der Datei wieder rückgängig machen!!!
Gruß
Franz
'Erstellt unter Excel 2003, Windows XP
'Code in einem allgemeinen Modul speichern - z.B. auch in der persönlichem Makro-Arbeitsmappe
Option Explicit
Private ZellAdressen() As String, ZellFarben() As Long
Private bMarkiert As Boolean, wksMarked As Worksheet
Sub UnprotectedCells_mark()
'nicht geschützte Zellen selektieren oder hellblau färben
Dim rUnprotected As Range, Zelle As Range, iIndex As Long
Dim wks As Worksheet
If bMarkiert = True Then Call UnMark_Unprotected
Set wks = ActiveSheet
For Each Zelle In wks.UsedRange
If Zelle.Locked = False Then
If rUnprotected Is Nothing Then
Set rUnprotected = Zelle
Else
Set rUnprotected = Application.Union(rUnprotected, Zelle)
End If
If wks.Protection.AllowFormattingCells = True Then
'Merken von Adresse und Farbe der nicht geschützten zellen
iIndex = iIndex + 1
ReDim Preserve ZellAdressen(1 To iIndex)
ZellAdressen(iIndex) = Zelle.Address
ReDim Preserve ZellFarben(1 To iIndex)
If Zelle.Interior.ColorIndex = xlColorIndexNone Then
ZellFarben(iIndex) = -1
Else
ZellFarben(iIndex) = Zelle.Interior.Color
End If
End If
End If
Next
If Not rUnprotected Is Nothing Then
If wks.Protection.AllowFormattingCells = True Then
'nicht geschützte Zellen farbig markieren
rUnprotected.Interior.ColorIndex = 8 'hellblau
bMarkiert = True
Set wksMarked = wks
Else
'nicht geschützte Zellen selektieren
rUnprotected.Select
End If
End If
End Sub
Sub UnprotectedCells_UnMark()
'ggf. Farbmarkierung nicht geschützter Zellen rückgängig machen
Dim iIndex As Long
If bMarkiert = True Then
For iIndex = LBound(ZellAdressen) To UBound(ZellAdressen)
If ZellFarben(iIndex) = -1 Then
wksMarked.Range(ZellAdressen(iIndex)).Interior.ColorIndex = xlColorIndexNone
Else
wksMarked.Range(ZellAdressen(iIndex)).Interior.Color = ZellFarben(iIndex)
End If
Next
Erase ZellAdressen
Erase ZellFarben
bMarkiert = False
Set wksMarked = Nothing
Else
MsgBox "Es sind zur Zeit keine ungeschützten Zellen farblich markiert"
End If
End Sub