Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
636to640
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

aktive Zelle in Farbe, geht auch z.b. über 3 Zelle

aktive Zelle in Farbe, geht auch z.b. über 3 Zelle
14.07.2005 12:52:58
Walter
Hallo experten,
habe einige Makros mal aus dem Forum erhalten für die aktive Zellen Darstellung in Farbe. Funktioniert !
Geht das auch über z.b. über mehrer Spalten hinweg z.b. wenn ich in "F3" bin, das dann die Zellen "A3-E3" ebenfalls in der gleichen Farbe dargestellt werden ?
Hier die Makros:
Public OldColor As Range

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error Resume Next
OldColor.Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = 3
Set OldColor = Target
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
'        .Unprotect "Test"
If Oldrange <> "" Then .Range(Oldrange).Interior.ColorIndex = OldColorIndex
'        .Protect "Test"
End With
End If
End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
'        .Unprotect "Test"
If Oldrange <> "" Then .Range(Oldrange).Interior.ColorIndex = OldColorIndex
'        .Protect "Test"
End With
End If
End Sub


Private Sub Workbook_Open()
If TypeName(ActiveSheet) = "Worksheet" Then
Oldrange = ActiveCell.Address
Register = ActiveSheet.Name
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
'       .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 5
'       .Protect "Test"
End With
End If
End Sub



Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If TypeName(ActiveSheet) = "Worksheet" Then
Oldrange = ActiveCell.Address
OldColorIndex = ActiveCell.Interior.ColorIndex
With ActiveSheet
'       .Unprotect "Test"
ActiveCell.Interior.ColorIndex = 5
'       .Protect "Test"
End With
Register = ActiveSheet.Name
End If
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If TypeName(ActiveSheet) = "Worksheet" Then
With Worksheets(Register)
'       .Unprotect "Test"
If Oldrange <> "" Then .Range(Oldrange).Interior.ColorIndex = OldColorIndex
'       .Protect "Test"
End With
End If
End Sub

'

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If TypeName(ActiveSheet) = "Worksheet" Then
With ActiveSheet
'        .Unprotect "Test"
'       Beim 1. Aufruf ist OldRange noch undefiniert
If Oldrange = "" Then
Oldrange = Target.Address
OldColorIndex = Target.Interior.ColorIndex
'       Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 5
Else
'       Setze alten Range auf alte Farbe
If Range(Oldrange).Interior.ColorIndex = 5 Then
Range(Oldrange).Interior.ColorIndex = OldColorIndex
End If
OldColorIndex = Target.Interior.ColorIndex
'       Merke mir aktuellen Adresse für nächsten Aufruf
Oldrange = Target.Address
'       Setze Hintergrundfarbe der aktiven Selection auf Rot
Target.Interior.ColorIndex = 5
End If
'        .Protect "Test"
End With
End If
End Sub

' **************************************************************
' Modul: Modul1 Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Public OldColorIndex As Variant
Public Oldrange As String
Public Register As String
Gruß Walter

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: aktive Zelle in Farbe, geht auch z.b. über 3 Zelle
14.07.2005 13:05:23
Werner
Hallo Walter
In etwa so ...
https://www.herber.de/bbs/user/24715.xls
Ist ein Teil aus einem Progi für Schützenverein
Gruss Werner
Genau so...
14.07.2005 13:17:51
Walter
Hallo Werner,
genau so,
Danke.
Frage noch kann ich meine Menge von Makros dann löschen, komm ich mit deinem
einzigen Makro aus ?
Gruß Walter
AW: Genau so...
14.07.2005 13:30:47
Werner
Hallo Walter
Der Code gehört hinter diese Tabelle in der Du das haben möchtest. Wenn Du eine anderes Blatt auswählst funktioniert der Code da nicht.
Du kannst den Code auch noch anpassen. Im Code ist z = Zeilenummer und s = Spaltennummer.
Hier nochmal den CODE ausgebessert. (Für jene die das GOTO nicht mögen)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
z = ActiveCell.Row
s = ActiveCell.Column
If z > 3 And s > 2 Then
Cells(2, s).Interior.ColorIndex = 8
Range(Cells(z, 1), Cells(z, s)).Interior.ColorIndex = 8
Cells(z, s).Interior.ColorIndex = 6
End If
End Sub

ACHTUNG: Wenn Du aber schon farbige Zellen im Blatt hast, werden die automatisch gelöscht.
Ich habe mir die anderen Code's nicht angeschaut. Weiss deshalb nicht was Du wirklich brauchst. Wenn Du die verschieden Code's mal studierst, wirst Du diese auf Deine Bedürfnisse anpassen können. Dabei lernst Du auch noch.
Gruss Werner
Anzeige
Hintergrund nicht löschen an Werner
14.07.2005 13:48:22
MathiasW
Hallo Werner,
das sieht ja ganz gut aus, aber besteht auch die Möglichkeit,
falls die Zellen schon farbig vorformatiert, diese Farben nicht zu löschne?
Da hätte ich folgenden Ansatz, ansonsten aber toller Code.
Die Formel kann dann unter bedingte Formatierung nachgeschaut werden.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

Sub Zeile_farbig()
Rows("3:20").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ZEILE(INDIREKT(ZELLE(""adresse"")))=ZEILE(A3)"
Selection.FormatConditions(1).Interior.ColorIndex = 17
Range("A12").Select
End Sub
Gruss Mathias
Anzeige
AW: Hintergrund nicht löschen an Werner
14.07.2005 14:43:23
Werner
Hallo Mathias
Da war mal was in einem Forum. Kann aber nicht mehr sagen welcher Author. Der hat die Zellfarben wieder zurückgebracht.
Vielleicht findest Du was im Netz.
Gruss Werner
Danke o.t.
14.07.2005 14:16:54
Walter
Hallo Werner,
herzlichen Dank für die Unterstützung und DANKE für die Hinweise.
Gruß Walter
Danke für die Rückmeldung OT:-)
14.07.2005 14:44:28
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige