RSS

Blinkende celler i Excel og OnTime funktionen

På denne side viser jeg, hvordan en makro automatisk kan få én eller flere celler til at blinke, hvis cellens indhold afviger fra en betingelse, og hvordan blinket ophører, hvis celleværdien bliver OK.

Eksemplerne demonstrerer samtidig, hvordan man med VBA's indbyggede OnTime funktion kan "planlægge" at eksekvere en procedure på et givet tidspunkt. Eksemplerne gør brug af Range-variabler.

Det minder meget om betinget formatering, men man kan ikke få celler til at blinke med betinget formatering - i hvert fald ikke i de gamle Excelversioner, jeg arbejder med.

Automatisk kørsel af kode

Hvert faneblad i et Excel-regneark har et tilhørende VBA kodeark, og her kan man lægge nogle standardprocedurer, som kaldes automatisk ved bestemte hændelser på fanebladet.

I eksemplerne nedenunder benytter vi os af Worksheet_Change proceduren, som kører automatisk, når en celle eller et område på fanebladet ændres, og det gælder også ved ændring af baggrundsfarven.

I det første eksempel er det kun én celle, vi får til at blinke; i det andet eksempel kan det være flere celler i et område. Du kan downloade et regneark med eksemplet her. Det er en komprimeret zip-fil, som du pakker ud ved at højreklikke og så vælge "extract," eller hvad Windows nu foreslår.

Blinkende celle

Det følgende eksempel vil få celle C2 til at blinke rødt, hvis en handling gør værdien negativ. I det tænkte eksempel kan celle A2 indeholde en indtægt, celle B2 en udgift og i celle C2 trækker vi udgiften fra indtægten. Hvis værdien bliver mindre end nul, blinker cellen rødt.

Åbn Excels VBA-editor (ALT+F11) og dobbeltklik på et af fanebladenes tilhørende kodeark. Hvis du ikke kan se disse, åbner du Project Explorer ved at trykke CTRL+R. Markér og kopiér (CTRL+C) flg. kode og indsæt den (CTRL+V) i fanebladets VBA-kodeark.

Hvis du læser siden på en lille skærm, kan nogle af kodelinjerne være "knækket," men kopierer du og indsætter i VBA-editoren, skulle det være okay med de rigtige linjeskift.


Option Explicit
Dim bCelleTjek As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

On Error GoTo ErrorHandle

'Hvert faneblad i et regneark har sit eget VBA-kodeark,
'hvor hændelser på fanebladet automatisk kan starte
'noget kode. Her benytter vi os af Worksheet_Change
'proceduren, som afvikles automatisk, hvis en celle
'eller et område ændres.
'I dette eksempel kaldes proceduren Startblink,
'hvis værdien i celle C2 er mindre end nul, og
'hvis flaget bCelleTjek er FALSK.
'Hvis værdien ændres og bliver større end nul,
'kaldes proceduren StopBlink.
'Udskift selv betingelsen og celleadressen efter behov.
'Procedurerne StartBlink og StopBlink ligger i et
'standardmodul, hvor også rangevariablen rRange er
'deklareret som public.

'Hvis værdien i C2 er negativ, og cellen ikke
'blinker allerede, startes blinket.
If Range("C2").Value < 0 And bCelleTjek = False Then
   Set rRange = Range("C2")
   StartBlink
   bCelleTjek = True
   'Hvis værdien i celle C2 ikke længere er negativ,
   'stoppes blinket.
ElseIf Range("C2").Value >= 0 And bCelleTjek = True Then
   Set rRange = Range("C2")
   StopBlink
   bCelleTjek = False
End If

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Worksheet_Change."
Set rRange = Nothing
bCelleTjek = False
End Sub

Nu skal du indsætte et modul (menuen "Insert" og vælg "Module") og indsætte flg. kode:


Option Explicit
Public rRange As Range
Dim dNextTime As Double

Sub StartBlink()
'Får en celle eller et range til at blinke med
'rød baggrundsfarve.

On Error GoTo ErrorHandle

With rRange.Interior
   If .ColorIndex = 3 Then   'Hvis baggrundsfarven er rød
      .ColorIndex = xlNone   'fjernes baggrundsfarven
   Else
      .ColorIndex = 3        'ellers gøres den rød
   End If
End With

'dNextTime sættes til nu plus 1 sekund
dNextTime = Now + TimeSerial(0, 0, 1)

'Proceduren får besked på at køre igen kl. dNextTime
Application.OnTime dNextTime, "StartBlink", , True

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure StartBlink."
Set rRange = Nothing
End Sub

Sub StopBlink()
'Denne procedure stopper blinkeriet.

On Error GoTo ErrorHandle

rRange.Interior.ColorIndex = xlNone

'Det næste kald af Startblink annulleres.
Application.OnTime dNextTime, "StartBlink", , False

BeforeExit:
Set rRange = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure StopBlink."
Resume BeforeExit
End Sub

Det var det. Celle C2 vil nu blinke rødt, hvis der ændres et eller andet, som gør celleværdien negativ, og blinkeriet vil ophøre, hvis værdien bliver nul eller højere.

Flere blinkende celler

Med det følgende eksempel kan du få flere celler i et område til at blinke, hvis de har negative værdier (eller...). Igen kan det være indtægter i kolonne A, udgifter i kolonne B og balancen (indtægter minus udgifter) i kolonne C startende i celle C2. Hvis noget ændres, så en værdi ikke længere er negativ, vil blinket ophøre for den pågældende celle.

Koden i standardmodulet skal være som ovenfor, men koden på fanebladets VBA-kodeark skal ændres til nedenstående.


Option Explicit
Dim bCelleTjek As Boolean
Dim bBlink As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rKolonne As Range
Dim rCell As Range
Dim sAdresse As String

On Error GoTo ErrorHandle

'For hvert faneblad i sit regneark kan man
'have en procedure Worksheet_Change, som kører
'automatisk, når en celle eller et område ændres.
'I dette eksempel vil alle celler fra C2 og ned
'til første tomme celle blinke rødt, hvis de
'indeholder en negativ værdi.
'Procedurerne StartBlink og StopBlink ligger i
'et standardmodul, hvor også rangevariablen rRange
'er deklareret som Public.

'Først definerer vi vores område som celle C2
'og ned til første tomme celle. Det er dette
'område vi vil tjekke for negative værdier.
Set rKolonne = Range("C2")

'Hvis der står noget i celle C3, udvides vores
'range nedad til første tomme celle.
If Not IsEmpty(Range("C3")) Then
   Set rKolonne = Range(rKolonne, rKolonne.End(xlDown))
End If

bCelleTjek = False

'Nu gennemløbes rKolonne, og adressen på hver celle,
'som indeholder en negativ værdi, føjes til streng-
'variablen sAdresse.
For Each rCell In rKolonne
   If rCell.Value < 0 Then
      bCelleTjek = True
      If Len(sAdresse) > 0 Then
         'Hvis sAdresse ikke er tom, tilføjes
         'celleadressen med et komma foran.
         sAdresse = sAdresse & "," & rCell.Address
      Else
         'Hvis det er den første celleadresse, skal
         'der ikke komma foran.
         sAdresse = sAdresse & rCell.Address
      End If
   End If
Next

If bCelleTjek = True And bBlink = False Then
   'rRange sættes til de celler, som
   'indeholder negative værdier.
   Set rRange = Range(sAdresse)
   bBlink = True
   'Kalder proceduren StartBlink
   StartBlink
   'Den følgende ElseIf er aktuel, hvis der er ændret
   'i en celle, hvis nogle celler allerede blinker, og
   'hvis der stadig er negative værdier.
ElseIf bCelleTjek = True And bBlink = True Then
   'Først stopper vi det gamle blink
   Set rRange = rKolonne
   StopBlink
   'Dernæst sætter vi rRange til de celler, som nu
   'indeholder negative værdier og starter blink igen.
   Set rRange = Range(sAdresse)
   StartBlink
   'Hvis der ikke længere er negative værdier, stoppes
   'blinket.
ElseIf bCelleTjek = False And bBlink = True Then
   Set rRange = rKolonne
   StopBlink
   bBlink = False
End If

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Worksheet_Change."
Set rRange = Nothing
Set rKolonne = Nothing
Set rCell = Nothing
bCelleTjek = False
End Sub

Det var det. Når cellerne blinker, kan du sagtens indsætte nye værdier, men du kan ikke kopiere celler, medmindre du kan gøre det på mindre end 1 sekund! Hvor meget grin der så er ved blinkende celler, ved jeg ikke, men det demonstrerer noget af det, man kan med VBA.

Relateret: