AW: Aktive Zellen und Spalten farbig - Lösung
22.01.2007 01:21:20
Luc:-?
Hallo Iris,
das sind 2 Probleme. Ich würde hier Ereignisprozeduren empfehlen. Damit die auch bei geschütztem Blatt fkt, müsstest du das Blatt auch per Ereignisprozedur schützen, damit Makros von der Einwirkungssperre ausgenommen wdn können, z.B so...
Option Explicit
Dim ws As Worksheet
Private Sub Worksheet_Activate()
Set ws = Me
ws.Protect password:="xyz", userinterfaceonly:=True
End Sub
Private Sub Worksheet_Deactivate()
Call ZeilenFarbe(ws, Nothing)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row <= endZl And Target.Column <= endSp And _
Target.Cells.Count <= endSp Then Call ZeilenFarbe(Me, Target)
End Sub
Das Vorstehende ist in das (Klassen-)Modul des Tabellenblattes zu kopieren (im Editor-Projektfenster auf das Symbol des TabBlattes doppelklicken). Das Nachfolgende muss an den Anfang eines Standardmoduls kopiert wdn...
Option Explicit
Public Const endZl As Long = 65536, endSp = 256
Rem Autor: Luc\CyWorX - 1Pub=CDate: 20070121 on www.herber.de/forum
Sub ZeilenFarbe(ByVal tbl As Worksheet, ByVal ziel As Range)
Static OrZst As Boolean, lzFrb(255) As Integer, letztZeile As Long, _
blatt As Worksheet, zelle As Range
Const invZlFrb As Integer = 56
On Error GoTo ex
Application.EnableEvents = False
If Not tbl Is Nothing Then Set blatt = tbl
If blatt Is Nothing Then GoTo ex
If ziel Is Nothing Then
For Each zelle In Range(blatt.Cells(letztZeile, 1), _
blatt.Cells(letztZeile, endSp))
zelle.Interior.ColorIndex = lzFrb(zelle.Column - 1)
Next zelle
OrZst = True
ElseIf OrZst Or ziel.Row <> letztZeile Then
If letztZeile > 0 Then
For Each zelle In Range(blatt.Cells(letztZeile, 1), _
blatt.Cells(letztZeile, endSp))
zelle.Interior.ColorIndex = lzFrb(zelle.Column - 1)
lzFrb(zelle.Column - 1) = blatt.Cells(ziel.Row, _
zelle.Column).Interior.ColorIndex
With Cells(ziel.Row, zelle.Column).Interior
.ColorIndex = Abs(IIf(invZlFrb > 56, invZlFrb Mod 56, _
invZlFrb) - IIf(.ColorIndex < 0, 0, .ColorIndex))
End With
Next zelle
Else
For Each zelle In Range(blatt.Cells(ziel.Row, 1), _
blatt.Cells(ziel.Row, endSp))
lzFrb(zelle.Column - 1) = blatt.Cells(ziel.Row, _
zelle.Column).Interior.ColorIndex
With blatt.Cells(ziel.Row, zelle.Column).Interior
.ColorIndex = Abs(IIf(invZlFrb > 56, invZlFrb Mod 56, _
invZlFrb) - IIf(.ColorIndex < 0, 0, .ColorIndex))
End With
Next zelle
End If
OrZst = False
ElseIf letztZeile > 0 And ziel.Cells.Count > 1 Then
For Each zelle In Range(blatt.Cells(letztZeile, 1), _
blatt.Cells(letztZeile, endSp))
zelle.Interior.ColorIndex = lzFrb(zelle.Column - 1)
Next zelle
OrZst = True
End If
letztZeile = ziel.Row
ex: Application.EnableEvents = True
End Sub
Die 3 Konstanten sind auf die Maxima bis xl2003 eingestellt, können aber nach Bedarf geändert wdn. Das gilt auch für invZlFrb. Dabei ist im Pgm abgesichert, dass Indexfarbe 56 nicht über- und 0 nicht unterschritten wdn kann. Weitere Änderungen sind nicht erforderlich.
Die Prozeduren reagieren auf Zeilen- und Blattwechsel. In beiden Fällen wird der Ausgangszustand der zuvor gewählten Zeile wiederhergestellt. Das geschieht auch, wenn mehr als 1 Zelle in der aktuellen Zeile ausgewählt wird, nicht aber, wenn die Anzahl der ausgewählten Zellen > endSp ist (nur wirksam, wenn hier max 255 eingestellt wird). Zellauswahlen außerhalb von endZl und endSp sind unwirksam. Wenn nach dem Aktivieren des TabBlattes eine Zelle (auch in der aktuellen Zeile, aber eine andere) ausgewählt wird, wdn die Zellen der 1.Spalten der Zeile bis endSp farblich pseudoinvertiert, d.h., es wird der Betragsdifferenzfarbindex aus invZlFrb und ursprünglichem Farbindex zur Farbgebung der Zeile der ausgewählten Zelle verwendet. So ist gewährleistet, dass die einzelnen Abteilungen auch in der aktuellen Zeile unterschiedliche Farben erhalten. Die erneute Auswahl einer Zelle in der bereits markierten Zeile bleibt wirkungslos, damit hier ungestört gearbeitet wdn kann.
Der Blattschutz muss vor dem Ersteinsatz des Programms aufgehoben und das voreingestellte Passwort "xyz" durch das gewünschte ersetzt wdn. Da dieses im Pgm im Klartext steht, empfehle ich, das VBA-Projekt ebenfalls zu schützen (rechter Mausklick auf VBA-Project, im Menü Eigenschaften anklicken und im PopUp entsprechend verfahren).
Viel Freude!
Luc :-?