AW: Teilbereich Blattschutz keine Formatierung
15.12.2010 20:03:42
Heinz
Hallo Lutz
Ich bin ein Trottel,wahrscheindlich liegt es an den Case
Sorry für die Unannemlichkeiten.
Ausser du wüsstest wie man im unteren Makro die Farbpalette trozdem aktiv halten kann.
Ich danke dir
Gruß
Heinz
Option Explicit
Sub Format_Values(Target As Range, Tsh As Worksheet)
Debug.Print "target= " & Target.Address & " Sheet= " & Tsh.Name
Sheets(Tsh.Name).Unprotect Password:="test"
Application.EnableEvents = False
With Sheets(Tsh.Name)
Dim Name_Bereich As Range, Kal_Bereich As Range, Zelle As Range
Dim wks As Worksheet, FarbeZ As Long, FarbeF As Long, Zeile As Long
Set wks = Tsh
Set Kal_Bereich = Sheets(Tsh.Name).Range("C3:AG154") 'Bereich in dem was geändert wird
Set Name_Bereich = Sheets(Tsh.Name).Range("A3:B154") 'Bereich mit Name und Schicht
Set Kal_Bereich = Intersect(Sheets(Tsh.Name).Range(Kal_Bereich.Address), Target)
Set Name_Bereich = Intersect(Sheets(Tsh.Name).Range(Name_Bereich.Address), Target)
If Not Kal_Bereich Is Nothing Then
For Each Zelle In Kal_Bereich
'Farben entsprechend Wert in Zelle setzen
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case ""
FarbeZ = 2: FarbeF = 0
Case "A= ANDERE ABWESENHEIT"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case "A"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case Else
FarbeZ = 2: FarbeF = 0
End Select
With Zelle
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
.Value = UCase(.Value)
End With
Next Zelle
ElseIf Not Name_Bereich Is Nothing Then
For Each Zelle In Name_Bereich
Zeile = Zelle.Row
'Farben entsprechend Wert in Spalte B setzen
Select Case UCase(Cells(Zeile, 2)) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
'######## Nullwerte in Spalte B #######
Case "0"
FarbeZ = 2: FarbeF = 1 'weiß - schwarz
Case Else
FarbeZ = xlColorIndexNone: FarbeF = xlColorIndexAutomatic
End Select
'Zellen in Spalte A und B im Monatsblatt formatieren, da Aenderung im Namensbereich
Application.EnableEvents = False
With Sheets(Tsh.Name).Range(.Cells(Zeile, 1), .Cells(Zeile, 2))
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
Next
End If
End With
Application.EnableEvents = True
If SchtPlNeu = False Then
End If
End Sub