Skifte mellem to ark automatisk

En bruger ville gerne have Excel til automatisk at skifte frem og tilbage mellem to ark i samme mappe. Indtil programmer blev lukket igen.

Der er umiddelbart ingen ben i, at lave en kode, der skifter mellem to ark:

Sub SkiftArk()
   If Activesheet.Name = "Ark1" Then
       Sheets("Ark2").Select
   Else
       Sheets("Ark1").Select
   End If
End Sub

vil skifte mellem to ark, Ark1 og Árk2. Denne kode skal ligge i et almindeligt modul. Udfordringen ligger i at få Excel til at gøre det automatisk. I Access findes en indbygget "timer" funktion, som kan sættes til  at udløbe med et bestemt interval. Dertil kommer hændelsen VedTimerudløb, som udløses hver gang timeren udløber, og som kan bruges til at afspille kode. En sådan timer findes ikke i Excel, så her er man nødt til at "lave den selv".

I artiklen om Hændelser under Programmering, nævner jeg hændelsen OnTime. Den udløses på et bestemt tidspunkt, forudsat at metoden er iværksat og at Excel er startet og den pågældende projektmappe åbnet på det pågældende tidspunkt. Tidspunktet kan være et konkret tidspunkt eller om et givet stykke tid. Koden kan altså afspilles fx 13.45 eller om 15 minutter. Man kan også få den til at afspille med tilbageværende mellemrum, og det er det, vi kan udnytte her. Dog skal koden være startet, før den virker. Jeg vælger derfor at lægge koden på Workbook_Open hændelsen i kodearket ThisWorkbook.

Private Sub Workbook_Open()
     Application.OnTime Now() + TimeValue("00:05:00"), "SkiftArk"
End Sub

Koden skal læses som, at den afspilles på det tidspunkt, vi har nu + 5 minutter. Det er nemt at ændre intervallet ved at ændre tallene i parentesen efter TimeValue. Skulle koden i stedet afspilles på et bestemt tidspunkt, kunne man nøjes med

Private Sub Workbook_Open()
     Application.OnTime  TimeValue("13:05:00"), "SkiftArk"
End Sub

Problemet med begge disse metoder er, at de kun afspiller koden én gang, og vi ville egentlig gerne have den gentaget. Vi opretter derfor en timer i et almindeligt modul, fx der hvor vi også har koden, der skal udføres:

Sub StartTimer()
       Application.OnTime Now + TimeValue("00:00:05"), "SkiftArk" ', Schedule:=True
End Sub

Så retter vi koden i ThisWorkbook til

Private Sub Workbook_Open()
     StartTimer
End Sub

og lader koden der faktisk udføres, starte timeren igen.

Sub SkiftArk()
   If Activesheet.Name = "Ark1" Then
       Sheets("Ark2").Select
   Else
       Sheets("Ark1").Select
   End If
   StartTimer
End Sub

- Tilbage til makroer -
- Tilbage til Excel -