Vba script crasht na 26 uur op sheet.activate

[badeend127]

Hoi iedereen

Ik ben bezig met het schrijven van wat vba code voor een tvscherm op het werk.
Het idee is dat dit scherm wat data weergeeft.
Elke 10 seconden ofzo verwisselt het scherm (naar een volgende sheet) om andere data te tonen.

Alles werkte tot ik voor langere tijd begon te testen.
Na ongeveer 26 uur slaat excel vast. Ik kan geen cel meer selecteren, er wordt geen data meer geplakt of naar een volgend scherm gegaan.
Ik heb logging voorzien en deze blijft wel werken. De code loopt dus nog en er komen geen errors.

Ik ben vervolgens begonnen met steeds meer code te commenten zodat ik kon zien waar het probleem zat.
Uiteindelijk schiet onderstaande code over (1).
Het probleem kan eigenlijk alleen maar bij wbl.Worksheets(sheetarray(j)).Activate zitten.
Om dit op te lossen heb ik geprobeerd de code wat aan te passen zodat de verwijzing sheetarray er niet in zit (2) nog steeds zonder succes.

Mijn ideeën zijn op. Ik kan enkel concluderen dat worksheet.activate niet werkt voor langere tijd.

Iemand die mij verder kan helpen?

Alvast bedankt!


Ik heb deze vraag ook al op een ander forum gesteld, zonder succes:
https://www.excelforum.com/excel-pr...e-due-to-worksheets-activate.html#post5521428


(1)

Sub waittime() 'main seq

Dim sheetarray(1 To 5) As String
sheetarray(1) = "A lijn"
sheetarray(2) = "B lijn"
sheetarray(3) = "ECA2"
sheetarray(4) = "ECA3"
sheetarray(5) = "ECA4"
Dim tijd As Date
Dim wisseltijd As Date
Dim wbl As Workbook
Set wbl = ThisWorkbook
'stoptijd = now() + TimeValue("11:01:00")
wisseltijd = now() + TimeValue("00:00:20")
refreshtijd = now()
tijd = now()

writetofile ("start")

Dim j As Integer
j = 1
DoEvents
While 1
    While now() < wisseltijd

    DoEvents
    Wend

    If now() > wisseltijd Then
    wbl.Worksheets(sheetarray(j)).Activate

    j = j + 1
        If j = 6 Then
        j = 1
        End If
    wisseltijd = now() + TimeValue("00:00:10")
    writetofile ("wissel" & sheetarray(j) & " " & wisseltijd)
    End If

    If now() > refreshtijd Then
    writetofile ("Refresh" & " " & refreshtijd)
   ' Removed for testing livewaarden (now())
'writetofile ("2")
    ' removed for testing (not the issue) readalarmalternative
'writetofile ("3")
    refreshtijd = now() + TimeValue("00:02:00")
    End If
Wend
'Next j
End Sub

(2)

Sub waittime() 'main seq

Dim sheetarray(1 To 5) As String
sheetarray(1) = "A lijn"
sheetarray(2) = "B lijn"
sheetarray(3) = "ECA2"
sheetarray(4) = "ECA3"
sheetarray(5) = "ECA4"
Dim tijd As Date
Dim wisseltijd As Date
Dim wbl As Workbook
Set wbl = ThisWorkbook
'stoptijd = now() + TimeValue("11:01:00")
wisseltijd = now() + TimeValue("00:00:20")
refreshtijd = now()
tijd = now()

writetofile ("start")

Dim j As Integer
j = 1
DoEvents
While 1
    While now() < wisseltijd

    DoEvents
    Wend

    If now() > wisseltijd Then
        DoEvents
        If j = 1 Then
         Sheet10.Activate
        End If
        If j = 2 Then
         Sheet11.Activate
        End If
        If j = 3 Then
         Sheet12.Activate
        End If
        If j = 4 Then
         Sheet9.Activate
        End If
        If j = 5 Then
         Sheet13.Activate
        End If
        
        j = j + 1
        If j = 6 Then
        j = 1
        End If
    wisseltijd = now() + TimeValue("00:00:10")
    writetofile ("wissel" & sheetarray(j) & " " & wisseltijd)
    End If

    If now() > refreshtijd Then
    writetofile ("Refresh" & " " & refreshtijd)
   ' Removed for testing livewaarden (now())
'writetofile ("2")
    ' removed for testing (not the issue) readalarmalternative
'writetofile ("3")
    refreshtijd = now() + TimeValue("00:02:00")
    End If
Wend
'Next j
End Sub

 

[snb]

Gebruik geen 'Select' of 'activate' in VBA.
Gebruik geen while wend, maar een Do ... Loop in VBA.
Gebruik application.ontime voor zoiets: https://www.snb-vba.eu/VBA_Application.OnTime.html

 

[badeend127]

Beste,

Bedankt voor uw bericht.
Kan u mij ook een alternatief voorstellen?
De bedoeling is namelijk dat er door de verschillende sheets wordt gecycled.
Ik snap dat in 99% van de gevallen activate niet nuttig is.
Dit is spijtig genoeg het 1% geval .

Mvg,

 

[cow18]

dat moet niet meer zijn dan dit.
Je kan beter met ontime werken, dan de processor dom bezig te houden met een loop af te lopen.

ik gok eerder dat er iets gebeurde met je j

If j [COLOR="#FF0000"][SIZE=5]>[/SIZE][/COLOR]= 6 Then j = 1

 

[badeend127]

Ga ik zeker eens testen!

Tnx!