VBA - einfärben | HERBERS Excel Forum

Forumthread: 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

AW: VBA - einfärben

Hajo_Zi
AW: VBA - einfärben

Josef
Flexibler

Josef
AW: Flexibler

WalterK

AW: VBA - einfärben

01.09.2012 18:36:04

Hajo_Zi

Hallo Walter,
siehe Dir das an
http://www.hajo-excel.de/vba_markieren_zelle.htm

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 »

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 »

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)

VBA - einfärben

Forumthread: VBA - einfärben

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

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread