Animerede diagrammer i Excel med VBA og Sleep-funktionen

Hvordan man kan lave animerede diagrammer i Excel med makroer og API funktionen Sleep til at indlægge pauser i koden. Regneark med eksempler kan downloades.

I forbindelse med mit arbejde ville jeg puste liv i en præsentation med animerede diagrammer for at visualisere en dynamisk udvikling.

Det er forholdsvis enkelt med makroer i VBA. Til et animeret søjlediagram, der får sin værdi fra en enkelt celle, opdaterer du bare celleværdien med en løkke.

Søjlen vil imidlertid ændre størrelse så hurtigt, at øjet knap kan følge med, og for at få en "flydende" animation skal man få koden til at holde pauser.

I videoen nedenunder kan du se eksempler på animerede diagrammer. Det zip-komprimerede regneark med makroerne kan downloades her. Den samme kode står også på denne side, men kopierer du den herfra, skal du selv lave diagrammerne.

Pauser i udførelsen af VBA makroer

Man kan få VBA-kode til at holde pauser på flere måder. Excel har fx en indbygget Wait-funktion:

Application.Wait Now + TimeSerial(0, 0, SecondsToWait)

Hvor koden vil holde pause i "SecondsToWait" sekunder. Imidlertid er det mindste tidsinterval 1 sekund, og det er alt for længe, hvis man vil have en "flydende" animation.

Excel har også en OnTime funktion, som kan "planlægge" kørsel af en procedure til et givet tidspunkt. På siden Blinkende celler viser jeg eksempler på brugen af OnTime.

Der er flere måder at holde pause på (se Chip Pearsons side Pausing Code Execution), men den bedste til animerede diagrammer er Windows' API-funktion "Sleep" kombineret med VBA's DoEvents funktion, som tillader ting at ske (her diagramopdatering), før koden fortsætter.

Sleep og DoEvents

Sleep-funktionen er en Windowsfunktion, man kan kalde fra sin VBA-kode. For at bruge funktionen, skal du indsætte følgende på modul-niveau; dvs. i toppen, hvor du også deklarerer variable for hele modulet eller projektet:

#If VBA7 And Win64 Then
    '64 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#Else
    '32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If

Sub Slumre()
   Sleep 100
   'Her skal koden med handling stå
   DoEvents 'Vent på at ting opdateres
End Sub

Herunder kan du se eksempler på kode til animerede diagrammer. Det er samme kode som i regnearket, du kan downloade - blot er kommentarerne i regnearket på engelsk.

Man kan forsyne diagrammerne med kildedata på flere måder. Man kan enten bruge værdier, som allerede findes i regnearket, eller man kan generere værdierne med en makro. Det er ikke så væsentligt.

Vigtigt er det derimod at fiksere diagrammets Y-akse, så den ikke ændrer sig dynamisk, i takt med at værdierne ændrer sig - det ser nemlig tosset ud.

Hvis du ikke kender den største værdi, som skal sætte skalaens øvre grænse. må du beregne den, før du starter animationen, og ændre skalaen i runtime.

Sub Chart1()
'Animerer en kurve ved at tilføje
'kildeværdier celle for celle og
'lade koden holde pause. Grafens
'kildedata er i cellerne B4:B28 på
'fanebladet "Data".
'Makroen kopierer værdierne en for en
'fra cellerne C4:C28, og grafen opdateres
'hver gang, en celleværdi er kopieret.
Dim rValues As Range 'Range for diagrammets kildedata
Dim rCell As Range   'Range variabel

On Error GoTo ErrorHandle

Application.ScreenUpdating = False

Worksheets("Data").Activate

Set rValues = Range("B4:B28")    'Diagrammets kildedata
rValues.ClearContents            'Slet gamle værdier
Worksheets("Chart1").Activate    'Aktivér fanebladet med diagrammet

Application.ScreenUpdating = True

'Nu gennemløbes ranget med kildedata celle
'for celle, og værdier kopieres. Ved at
'tvinge koden til at holde pause, får vi
'animationseffekten.
'Hvis der ikke blev indlagt pauser, ville
'det hele være overstået på et øjeblik,
'medmindre computeren er meget langsom.
For Each rCell In rValues
   'Hold pause i 50 millisekunder
   Sleep 50
   'Kopierer værdi til kildedata
   rCell.Value = rCell.Offset(0, 1).Value
   'Giv tid til diagramopdatering
   DoEvents
Next

BeforeExit:
Set rValues = Nothing
Set rCell = Nothing

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

Den næste makro animerer et søjlediagram og et lagkagediagram på fanebladet "Chart2". De 3 søjler viser de absolutte værdier, og lagkagediagrammet fordelingen i procent.

Søjlernes kildedata er i cellerne A4:C4 på fanebladet "Data," og lagkagediagrammets kildedata er i cellerne N4:P4.

En løkke kopierer de originale værdier fra en tabel til kildedata, og vi får animationseffekten ved at indlægge pauser.

I eksemplet ovenfor var pausetiden på 50 millisekunder skrevet i makroen, mens vi her indlæser den i variablen lSleep fra celle C25 på fanebladet "Chart2". Og nu ikke mere snak:

Sub Chart2()
'Laver et animeret søjle- og lagkagediagram.
Dim rInput As Range  'Første kolonne med værdier, som skal kopieres
Dim rCell As Range   'Range variabel
Dim rBarA As Range   'Søjle A's kildecelle
Dim rBarB As Range
Dim rBarC As Range
Dim rPieA As Range   'Lagkagestykke A's kildecelle
Dim rPieB As Range
Dim rPieC As Range
Dim lSleep As Long

On Error GoTo ErrorHandle

Application.ScreenUpdating = False

Worksheets("Data").Activate

'Nu defineres vores ranges
Set rInput = Range("E4:E28")
Set rBarA = Range("K4")
Set rBarB = Range("L4")
Set rBarC = Range("M4")
Set rPieA = Range("N4")
Set rPieB = Range("O4")
Set rPieC = Range("P4")

Worksheets("Chart2").Activate

'Indlæs pausetiden i millisekunder
lSleep = Range("C25").Value

Application.ScreenUpdating = True

'Nu kører løkken
For Each rCell In rInput
   'Hold pause i lSleep millisekunder
   Sleep lSleep
   With rCell
      rBarA.Value = .Value
      rBarB.Value = .Offset(0, 1).Value
      rBarC.Value = .Offset(0, 2).Value
      rPieA.Value = .Offset(0, 3).Value
      rPieB.Value = .Offset(0, 4).Value
      rPieC.Value = .Offset(0, 5).Value
   End With
   DoEvents 'Giv tid til diagramopdatering
Next

BeforeExit:
Set rBarA = Nothing
Set rBarB = Nothing
Set rBarC = Nothing
Set rPieA = Nothing
Set rPieB = Nothing
Set rPieC = Nothing
Set rInput = Nothing
Set rCell = Nothing

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

Animerede diagrammer i Excel med VBA makroer

Pauser i udførelsen af VBA makroer

Sleep og DoEvents