• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

ESC in Excel om VBA-code te stoppen

Status
Niet open voor verdere reacties.

SaskiaHe

Gebruiker
Lid geworden
18 jan 2010
Berichten
5
Wie kan mij helpen,

Ik heb een soort van metronoom nagebootst in VBA-code in Excel.

Als een tabblad wordt geopend, wordt een UserForm geopend.
Na het invullen van een veld (invullen metronoomsnelheid) moet je op een Button klikken waarna er in een "eindeloze loop" om de zoveel (milli)seconden (afhankelijk van de invoer) een "klik" als geluid wordt afgespeeld.

Ik wil deze "eindeloze loop" afbreken zodra ik op de ESC-toets druk. Echter, soms gaat dit goed en soms krijg ik dat het Userform en Excel niet reagreren en kan ik ze alleen maar via de TaskManager afbreken. Hieronder volgt de (m.i.) relevante code:

Bij het openen van een blad wordt de MM-snelheid van het blad in het invoerscherm gekopieerd en het invoerscherm getoond.

Code:
Private Sub Worksheet_Activate()
    Invoer.Snelheid.Value = Range(MMcel).Value
    Invoer.Show
End Sub

Daarna wordt onderstaande routine aangeroepen. Helaas stopt deze niet altijd bij het gebruik van de ESC-toets (soms wel ...). Soms heb ik er ook wel eens de foutmelding "28 Stack overflow" uitgekregen (via ErrHandler), maar meestal blijft hij gewoon eindeloos doortikken.

Code:
Sub Metronoom()
    Application.EnableCancelKey = xlErrorHandler
    On Error GoTo ErrHandler

Const forever = True
Dim Rij As Integer
Dim MM As Integer
Dim msec As Integer
Dim i As Integer

    MM = Invoer.Snelheid.Value

    ActiveWorkbook.Save
    msec = 1000 * (60 / MM)
    
    While forever
        Call sndPlaySound32("C:\Users\EIGENAAR\Documents\Data\Muziek\Click.wav", 0)
        Call Sleep(msec)
    Wend
    
    Exit Sub

ErrHandler:
    If Err.Number <> 18 Then
        Call MsgBox(Err.Number & " - " & Err.Description, vbOKCancel)
    End If
End Sub

De twee routines die in de forever-loop worden aangeroepen zien er als volgt uit:

Code:
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
       
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Wie weet raad ???

Saskia
 
Saskia,

Een routine is altijd af te breken met CTRL+Break.
 
Ja, de wijze waarop ik hem afbreek maakt me niet zoveel uit.

Maar als het UserForm eenmaal op "reageert niet" is gesprongen, werkt ook CTRL-Break niet, helaas. Ik start de macro vanuit het Userform, niet direct vanuit VBA.
 
Saskia,

Of je een macro start vanuit VBA, een werkblad, een Userform o.i.d. maakt niet uit.

Maar jij krijgt de melding reageert niet en dan is het een andere kwestie.

Probeer het commando Do.Events eens te plaatsen voor Call Sleep(msec)

Ik weet niet of dit gaat werken maar probeer het eens.
 
Saskia,

Kun je het progje plaatsen zodat we kunnen zien wat er precies gebeurd.
 
Ik heb de spreadsheet bijgesloten. Zoals het nu is, moet je even niet naar het doel vragen, want ik heb zoveel mogelijk coding gestript zodat het nog net niet werkt. Maar als je vanaf het blad MM snelheid naar AV Allegro gaat, krijg je een userform voor je neus met daarin de waarde vanuit het vel E1 ingevuld (deze coding zit achter het werkblad). Druk je op het driehoekje, dan hoor je een metronoom tikken in de snelheid die aangegeven is met aantal slagen per minuut (via de button wordt de routine Metronoom in module1 aangeroepen).

Deze zou moeten stoppen zodra je op ESC drukt, soms doet-ie dat ook. Soms blijft hij vrolijk doortikken.

Mocht iemand een andere manier weten om het tikken weer te stoppen, dan houd ik me van harte aanbevolen, zolang er in het forever-loopje maar niet te veel of te zware coding komt te staan, want het getik moet natuurlijk wel regelmatig en zo exact mogelijk.

Ik ben benieuwd ...

Alvast bedankt.
 
Laatst bewerkt:
Hartelijk dank allen die meegedacht hebben. Het lijkt dat DoEvents de klus klaart.

Bedankt, ik ga weer verder tikken.
 
Tik je de vraag dan nog even op opgelost (rechts onderaan de pagina)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan