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
If Range("C2").Value < 0 And bCelleTjek = False Then
Set rRange = Range("C2")
StartBlink
bCelleTjek = True
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()
On Error GoTo ErrorHandle
With rRange.Interior
If .ColorIndex = 3 Then
.ColorIndex = xlNone
Else
.ColorIndex = 3
End If
End With
dNextTime = Now + TimeSerial(0, 0, 1)
Application.OnTime dNextTime, "StartBlink", , True
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure StartBlink."
Set rRange = Nothing
End Sub
Sub StopBlink()
On Error GoTo ErrorHandle
rRange.Interior.ColorIndex = xlNone
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
Set rKolonne = Range("C2")
If Not IsEmpty(Range("C3")) Then
Set rKolonne = Range(rKolonne, rKolonne.End(xlDown))
End If
bCelleTjek = False
For Each rCell In rKolonne
If rCell.Value < 0 Then
bCelleTjek = True
If Len(sAdresse) > 0 Then
sAdresse = sAdresse & "," & rCell.Address
Else
sAdresse = sAdresse & rCell.Address
End If
End If
Next
If bCelleTjek = True And bBlink = False Then
Set rRange = Range(sAdresse)
bBlink = True
StartBlink
ElseIf bCelleTjek = True And bBlink = True Then
Set rRange = rKolonne
StopBlink
Set rRange = Range(sAdresse)
StartBlink
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:
|