Knipperende celkleur

[HMDH]

graag zou ik cel D4 van de bijlage laten knipperen.
Deze cel kan verschillende kleuren hebben.
Niet de tekst maar de ingekleurde cel moet knipperen.
Ik heb wel wat op internet gevonden maar dat zijn macro's die ik zelf moet starten.
De bedoeling is dat de cel D4 gaat knipperen als het tabblad "Clubuitslag" wordt geopend.

Kan iemand een VBA code o.i.d. voor mij maken?

 

[edmoor]

De codes die je hebt gevonden kan ook laten activeren doordat het blad actief wordt, d.m.v. het Worksheet_Activate() event.

 

[HMDH]

Helaas ben ik niet zo bij de hand als jullie Excel specialisten.
Ik ben van het knippen en plakken.
Hopelijk kan iemand iets in mijn voorbeeld doc. maken zodat ik dat kan aanpassen.

 

[edmoor]

Laat dan eens zien wat je had gevonden.

 

[HMDH]

Onderstaande heb ik gevonden.
Ik wil dus de cel en niet de tekst laten knipperen en het knipperen laten starten bij het openen van het betreffende tabblad.


Sub StartBlink()
Dim xCell As Range
Dim xTime As Variant
On Error Resume Next
Set xCell = Range("Clubuitslag!D4")
On Error Resume Next

If xCell.Font.Color = vbRed Then
xCell.Font.Color = vbWhite
Else
xCell.Font.Color = vbRed
End If
xTime = Now + TimeSerial(0, 0, 1)
Application.OnTime xTime, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub

 

[edmoor]

Klik op het Blad Clubuitslag.

 

[popipipo]

Je hebt font.color en Interior.color

 

[sylvester-ponte]

vbYellow

 

[edmoor]

vbYellow is 65535.
De gebruikte gele tint is 13434879.
vbWhite kan natuurlijk vervangen worden door vbYellow.

 

[HMDH]

edmoor,

het document laat zich niet meer afsluiten. (?)
Blijkbaar zit het in een soort van loop.

Ik kan het wel sluiten maar dan moet ik de code;

Private Sub Worksheet_Activate()
StartBlink
End Sub

Uitschakelen met een [ ' ]

2e puntje is dat de bewuste D4 cel is voorzien van een Voorwaardelijke opmaak met 4 verschillende kleuren.

Zie nieuwe bijlage.

 

[edmoor]

Het document dat ik plaatste in #6 werkt prima.
Het gebruik van de hoofdkleur kan je aanpassen door deze eerst op te halen.
Dat zal met conditional format lastig zijn om het te laten wrken.

 

[HMDH]

Ja, bedankt.

is alleen nog niet opgelost.

Mogelijk is er een forumlid die dit voor mij kan oplossen.

 

[HSV]

@Ed.
Er mist nog een BeforeClose 'Application ontime ......,,false zodat niet telkens het bestand opnieuw opstart bij het sluiten.

Tip: Zet alle codes in ThisWorkbook.

 

[edmoor]

Klopt inderdaad.
Maar in het laatst geplaatste document wordt gebruik gemaakt van voorwaardelijke opmaak.
Daar doe ik zelf nooit iets mee en heb dus nog niet gekeken hoe het daarin zou kunnen werken.
Weet jij dat?

 

[HSV]

Voorwaardelijke opmaak voert de boventoon dus de onderliggende kleur die veranderd wel maar zie je niet.
In al mijn vorige versies kon je in VBA niet veel doen met voorwaardelijke opmaak.
Ik heb sinds 28 januari Office 365 en kan m'n weg er nog niet goed in vinden.

Sowieso heb ik niet veel met kleurplaten.

 

[edmoor]

Dan zal TS moeten wachten op iemand anders of een andere opzet bedenken.
Zelf heb ik een gruwelijke hekel aan voorwaardelijke opmaak.

 

[HSV]

Zelf heb ik een gruwelijke hekel aan voorwaardelijke opmaak.

Idem, bij kopiëren en plakken word je beroerd als je in het venster kijkt bij Vw-opmaak.

 

[HMDH]

aan alle,
ik heb er nu voor gekozen om niet de cel te laten knipperen (voorwaardelijke opmaak) maar de tekstkleur.
Dit werkt nu wel.

Alleen weet ik niet wat HSV bedoeld met;

Er mist nog een BeforeClose 'Application ontime ......,,false zodat niet telkens het bestand opnieuw opstart bij het sluiten.

Tip: Zet alle codes in ThisWorkbook.

Onderstaande zit in mijn module 9

Sub StartBlink()
Dim xCell As Range
Dim xTime As Variant
Dim Geel As Long

On Error Resume Next
Set xCell = Range("Clubuitslag!D4:I4")
'Geel = 13434879
On Error Resume Next

If xCell.Font.Color = Black Then
xCell.Font.Color = vbRed
Else
xCell.Font.Color = Black
End If

xTime = Now + TimeSerial(0, 0, 1)
Application.OnTime xTime, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub

Wat moet er dan worden aangepast??

 

[HSV]

Verwijder al je codes, en verwijder de module.

Onderstaande code in zijn geheel in Thisworkbook plakken.

Private t

Private Sub Workbook_Open()
 ThisWorkbook.StartBlink
End Sub

Sub StartBlink()
Set xCell = Sheets("clubuitslag").Range("D4:I4")
  xCell.Font.Color = IIf(xCell.Font.Color = Black, vbRed, Black)
  t = DateAdd("s", 1.5, Time)
 Application.OnTime t, "ThisWorkbook.StartBlink"
End Sub

[COLOR=#008000]'Private Sub Workbook_SheetActivate(ByVal Sh As Object)  'in principe overbodig.[/COLOR]
[COLOR=#008000]'If Sh.Name = "Clubuitslag" Then ThisWorkbook.StartBlink[/COLOR]
[COLOR=#008000]'End Sub[/COLOR]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Application.OnTime t, "Thisworkbook.startblink", , False
End Sub

 

[snb]

@HSV

Herkent VBA dit ?

IIf(xCell.Font.Color = Black, vbRed, Black)

of anders

IIf(xCell.Font.Color = vbBlack, vbRed, vbBlack)

Ja. blijkbaar wel bleek uit de test.

voor de gein:

With Sheets("clubuitslag").Range("D4:I4").Font
  .Color = -255 * (.Color = 0)
End With