Een loop stoppen met een command button

[pepijndb]

Beste Excel gebruikers,

Ik heb het volgende probleem:
Voor mijn werk moet ik een presentatie via Excel laten runnen. Dit omdat er software geïmplementeerd zit in excel die continu live-values ophaalt.
Om dit voor elkaar te krijgen heb ik dus een loop gemaakt die constant door 3 tabbladen gaat en deze toont op het scherm.
Het probleem is echter dat het in een halmonitor wordt gedisplayed die alleen een muis gebruikt. Hiervoor moet ik dus een command button maken die de loop stopt.

Deze command button kan ik tijdens de loop niet gebruiken, mijn muis blijft op het laadsymbool staan.
Is er een manier om dit op te lossen, zo ja, ik ben geen VBA expert. Dus is er kans dat iemand mijn code kan aanpassen voor deze oplossing?

De startmacro van de slideshow:

Sub slideshow_beginnen()

Sheets("Settings").Range("B10").Value = 1
Do Until Sheets("Settings").Range("B10").Value = 0


Call blad_1

Call blad_2

Call blad_3

Loop


End Sub
______________________________________________________________________

Private Sub blad_1()
Sheets(1).Select
Application.Wait Now() + TimeValue(Sheets("Settings").Range("B1").Text)

End Sub
______________________________________________________________________

Private Sub blad_2()
Sheets(2).Select
Application.Wait Now() + TimeValue(Sheets("Settings").Range("B2").Text)

End Sub
______________________________________________________________________

Private Sub blad_3()
Sheets(3).Select
Application.Wait Now() + TimeValue(Sheets("Settings").Range("B3").Text)

End Sub
______________________________________________________________________


En de macro om de slideshow te stoppen:

Sub Slideshow_stoppen()
Sheets("Settings").Range("B10").Value = 0

End Sub

Bij voorbaat hartelijk dank.

Met vriendelijke groet,

Pepijndb

 

[Timshel]

Als je code tussen tags plaatst ziet je bericht er een stuk overzichtelijker uit:

Sub slideshow_beginnen()
Herhaal:
    Call blad(1)
    Call blad(2)
    Call blad(3)
    GoTo Herhaal
End Sub

Private Sub blad(x As Long)
    Sheets(x).Select
    Application.Wait Now() + TimeValue(Sheets("Settings").Range("B" & x).Text)
    DoEvents
End Sub

Sub Slideshow_stoppen()
    MsgBox "Klaar!"
    End
End Sub

 

[pepijndb]

Hartelijk bedankt! Werkt als een zonnetje!