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.
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.
De twee routines die in de forever-loop worden aangeroepen zien er als volgt uit:
Wie weet raad ???
Saskia
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