Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1276to1280
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
Inhaltsverzeichnis

VBA - einfärben

VBA - einfärben
WalterK
Hallo,
im Blatt "Jahr 2012" habe ich die Bereiche A und B: Die beiden Bereiche sind immer gleich groß.
Wenn die aktive Zelle in einem der Bereiche ist, sollte die Hintergrundfarbe dieser aktiven Zelle gelb sein, nach dem Verlassen sollte die gelbe Farbe wieder weg sein. Im jeweils anderen Bereich sollte die Zwillingszelle (= Zelle mit der gleichen Position im Bereich) gleichzeitig ebenfalls gelb hinterlegt sein.
Das ganze soll in jedem Blatt funktionieren, bei dem der Blattname mit Jahr beginnt.
Hier ist eine Beispieltabelle:
https://www.herber.de/bbs/user/81678.xls
Besten Dank für die Hilfe und Servus, Walter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA - einfärben
01.09.2012 19:23:38
Josef

Hallo Walter,
in das Modul "DieseArbeitsmappe".
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rngC As Range
  
  If Sh.Name Like "Jahr*" Then
    Set rng = Sh.Range("E5:P15,V5:AG15")
    rng.Interior.ColorIndex = xlNone
    If Not Intersect(Target(1, 1), rng) Is Nothing Then
      If Not Intersect(Target(1, 1), rng.Areas(1)) Is Nothing Then
        Set rngC = Intersect(Target(1, 1), rng.Areas(1))
        rngC.Interior.ColorIndex = 6
        rng.Areas(2).Cells(rngC.Row - 4, rngC.Column - 4).Interior.ColorIndex = 6
      Else
        Set rngC = Intersect(Target(1, 1), rng.Areas(2))
        rngC.Interior.ColorIndex = 6
        rng.Areas(1).Cells(rngC.Row - 4, rngC.Column - 21).Interior.ColorIndex = 6
      End If
    End If
  End If
  
End Sub



« Gruß Sepp »

Anzeige
Flexibler
01.09.2012 20:01:02
Josef
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rngC As Range
  
  If Sh.Name Like "Jahr*" Then
    Set rng = Sh.Range("E5:P15,V5:AG15")
    rng.Interior.ColorIndex = xlNone
    If Not Intersect(Target(1, 1), rng) Is Nothing Then
      If Not Intersect(Target(1, 1), rng.Areas(1)) Is Nothing Then
        Set rngC = Intersect(Target(1, 1), rng.Areas(1))
        rngC.Interior.ColorIndex = 6
        rng.Areas(2).Cells(rngC.Row - rng.Areas(1).Cells(1, 1).Row + 1, _
          rngC.Column - rng.Areas(1).Cells(1, 1).Column + 1).Interior.ColorIndex = 6
      Else
        Set rngC = Intersect(Target(1, 1), rng.Areas(2))
        rngC.Interior.ColorIndex = 6
        rng.Areas(1).Cells(rngC.Row - rng.Areas(2).Cells(1, 1).Row + 1, _
          rngC.Column - rng.Areas(2).Cells(1, 1).Column + 1).Interior.ColorIndex = 6
      End If
    End If
  End If
  
End Sub


« Gruß Sepp »

Anzeige
AW: Flexibler
01.09.2012 20:11:43
WalterK
Hallo Sepp,
besten Dank für die perfekte Lösung!!
Danke auch an Hajo.
Servus, Walter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige