Voorwaardelijke kleur opvragen

[Morsyd]

Hallo,

Ik heb een bereik gegevens in de kolommen B tot en met H.
De voorwaardelijke opmaak (zwarte of rode tekstopmaak) van de waarden in kolom E is ingesteld via de klassieke manier in Excel (Start > Stijlen > Voorwaardelijke opmaak).
Daarnaast heb ik een VBA-code die oa. een controle uitvoert op de tekstkleur in kolom E.
Ik had graag gehad dat de volgende actie uitgevoerd wordt wanneer de voorwaardelijke opmaak van de cel in kolom E rood is.

    Dim c As Range
        For Each c In ActiveSheet.UsedRange.Columns("B").Cells
                    If Cells(c.Row,5).Font.ColorIndex = 3 Then
                        VolgendeMacro
                    End If
        Next c

Wanneer ik ter controle eens de kleur opvraag van een bepaalde cel (waarvan ik weet dat ze via voorwaardelijke opmaak in't rood wordt gezet) krijg ik als waarde "-4105", en niet de waarde "3)...
Ik krijg deze waarde "-4105" trouwens ook bij zwarte cellen, wat het nog bizarder maakt.

Kan iemand me helpen?
Alvast bedankt!

 

[edmoor]

Zo bizar is dat niet. Het is een feit dat je een kleur die door voorwaardelijke opmaak is aangebracht niet met VBA kan ophalen.

 

[Morsyd]

Aha, oké, dan zal ik er wss voor moeten kiezen om de formule die in de klassieke voorwaardelijke opmaak zit, ook in m'n code te brengen.
Alvast bedankt!!

 

[VenA]

Volgens mij kan je ook de opmaak die via VO is ingesteld opvragen. Het hoe is geheel afhankelijk van wat in het niet geplaatste voorbeeldbestand staat.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) <> "A1" Then Exit Sub
    For j = 1 To Target.FormatConditions.Count
    If Evaluate(Target.FormatConditions(j).Formula1) Then
      Target.Offset(, 1) = Target.FormatConditions(j).Interior.Color
      Exit For
    End If
  Next j
End Sub

 

[HSV]

Hallo,
Ik had graag gehad dat de volgende actie uitgevoerd wordt wanneer de voorwaardelijke opmaak van de cel in kolom E rood is.
Alvast bedankt!

Je kan uiteraard alle kleuren opvragen van de voorwaardelijke opmaak van die cel, maar niet de kleur die de cel heeft met de code van mijn voorganger.

Voorbeeld.
Je hebt vijf voorwaardelijke opmaken voor cel A1:A10; vier voor de cellen A1:A6, en eentje voor A10.
Als de cel dus aan een van voorwaarden voldoet zal het die kleur meekrijgen.

Onderstaande code doet het iets anders en zet de kleur die de cel van de Vw-opmaak heeft gekregen ernaast.

Sub hsv()
Dim j As Long, cl As Range, i, fc As FormatCondition, c00, c01
For Each cl In Range("a1:a10")
  For j = 1 To cl.FormatConditions.Count
   Set fc = cl.FormatConditions(j)
     c01 = Split(fc.Formula1, "=")(UBound(Split(fc.Formula1, "=")))
     If IsNumeric(c01) Then
        c00 = c01
      Else
        c00 = Replace(c01, """", "")
      End If
     If cl.Text = c00 Then
     cl.Offset(, 1) = fc.Interior.ColorIndex
       Exit For
     Else
       cl.Offset(, 1) = ""
    End If
  Next j
 Next cl
End Sub

Ps. Hier zit niet de xlbetween Vw-opmaak bij inbegrepen.

 

[Morsyd]

Je kan uiteraard alle kleuren opvragen van de voorwaardelijke opmaak van die cel, maar niet de kleur die de cel heeft met de code van mijn voorganger.

Voorbeeld.
Je hebt vijf voorwaardelijke opmaken voor cel A1:A10; vier voor de cellen A1:A6, en eentje voor A10.
Als de cel dus aan een van voorwaarden voldoet zal het die kleur meekrijgen.

Onderstaande code doet het iets anders en zet de kleur die de cel van de Vw-opmaak heeft gekregen ernaast.

Sub hsv()
Dim j As Long, cl As Range, i, fc As FormatCondition, c00, c01
For Each cl In Range("a1:a10")
  For j = 1 To cl.FormatConditions.Count
   Set fc = cl.FormatConditions(j)
     c01 = Split(fc.Formula1, "=")(UBound(Split(fc.Formula1, "=")))
     If IsNumeric(c01) Then
        c00 = c01
      Else
        c00 = Replace(c01, """", "")
      End If
     If cl.Text = c00 Then
     cl.Offset(, 1) = fc.Interior.ColorIndex
       Exit For
     Else
       cl.Offset(, 1) = ""
    End If
  Next j
 Next cl
End Sub

Ps. Hier zit niet de xlbetween Vw-opmaak bij inbegrepen.

Wow, hartelijk dank HSV! Dit lijkt wel iets waarmee ik verder kan.
Kan je mij wel eens uitleggen wat gebeurt in volgende code:

     c01 = Split(fc.Formula1, "=")(UBound(Split(fc.Formula1, "=")))

Hartelijk dank!

 

[HSV]

Als de Vw-opmaak formule bv. "=$A$1=2", dan doet dat stukje code niets anders dan de formule opdelen in stukjes na de "=".

c01 = Split(fc.Formula1, "=")(UBound(Split(fc.Formula1, "=")))

c01 = split de formule dmv van het "=" teken en geef met Ubound het laatste gedeelte als resultaat.
Er staat dus 2x een "=" teken en pakt dan de laatste met Ubound.

Lbound = het eerste gedeelte (0) = $A$1
Ubound = het laatste gedeelte, in dit geval (1) = 2
c01 geeft als resultaat 2

Nu gaan we c01 vergelijken met wat er werkelijk in de cel staat, als dit ook een 2 is zet dan de kleurnummer van de Vw-opmaak in de cel ernaast.

Maar voor alle mogelijkheden werkt het natuurlijk niet, zoals; vw-opmaak kent ook een xlbetween (waarde tussen twee getallen).
Of: "=EN(ISLEEG($A$1;ISLEEG($A$2))" geeft WAAR of ONWAAR.
Dan zouden we de code moet uitbreiden.
Als ik daar eens tijd voor vind, zal ik me daar eens mee bezighouden.

Edit:

Interessant is dat als je de Vw-opmaak "Bevat" gebruikt (daar heb ik het woord "tekst" ingevoerd), dat de fc.formula1 = "=NIET(ISFOUT(VIND.SPEC("tekst";A1)))" oplevert.
Iets wat Excel dus zelf aanmaakt.

 

[E v R]

Vanaf XL2010 kun je displayformat gebruiken

 

[HSV]

Bedankt Eric, dan ga ik daar met mijn Excel 2007 geen tijd meer aan verspillen.

 

[VenA]

@E v R, Mooie aanvulling.:thumb: Het blijft een lastig object in oudere versies zeker als je ook nog rekening moet houden met Stop = True.

Vanaf XL-2010 kan de code van HSV herschreven worden tot zoiets

Sub VenA()
For Each cl In Columns(1).SpecialCells(-4172) 
  cl.Offset(, 1) = cl.DisplayFormat.Interior.ColorIndex
Next cl
End Sub