How to Solve Undesirable Alt key Behavior?

G

glasstronomic

New Member
Joined
Apr 29, 2009
Messages
10
Office Version
  1. 365
Hi friends,

I'm a long time lurker and first time poster who needs help.

I have a complex project that works great, except for one issue that has me at wit's end.

It has many necessary loops with disciplined use of DoEvents and assuring no concurrent loops. It is intended for blind users who must operate it in conjunction with screen reader apps, so it depends heavily on accelerator keys and is mindful of focus conditions.

The problem is when the main UserForm named ControlPanel has focus, Alt+ accelerator keys work fine. But tapping or holding and releasing Alt without an accelerator key pauses execution and makes ControlPanel unresponsive until Alt is tapped again. This is especially problematic for blind users who don't get immediate feedback that this has occurred. As far as they can tell, the thing just stopped working. The fix of tapping again is in the readme, but y'all know about users and readme's.

I have beat my head against the wall all weekend while struggling with this. Even ChatGPT gave up and admitted it can't fix it after days of different attempts including Windows API calls, disabling Excel's default Alt key handling, modal and modeless form displays (the form must remain modeless for reader compatibility reasons), and many others. So many Debug.Print and so many failures.

Can you help? Code for ControlPanel...

VBA Code: 
Option Explicit

#If VBA7 Then
    ' Sleep function for VBA7 (Excel 2010 and later)
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    ' Sleep function for older VBA versions (Excel 2007 and earlier)
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Sub UserForm_Initialize()
  
    ' some stuff I have to hide for privacy, sorry, should not affect keyups or keydowns

End Sub

Private Sub UserForm_Activate()

    cntrlPnl = True
    isPausedBkwd = True
    isPausedFwd = True
    stopPlayback = False
    zmLp = False
  
    currentRow = 1
    previousRow = 2
    ProgressBar.Enabled = True
    ProgressBar.Refresh
    ProgressBar.Min = 1
    ProgressBar.Max = lastRow
    ProgressBar.Value = currentRow
  
    If firstImport <> False Then stereoWide = True
  
    If stereoWide = False Then
        StereoWidth.Caption = "Stereo is narrow" & vbCrLf & "Key Alt+w"
        StereoWidth.ControlTipText = "Stereo is narrow"
    Else
        StereoWidth.Caption = "Stereo is wide" & vbCrLf & "Key Alt+w"
        StereoWidth.ControlTipText = "Stereo is wide"
    End If
  
    ImportedFileName.Caption = fileName
    ImportedFileName.ControlTipText = fileName
    DataPoints.Caption = lastRow & " data points"
    DataPoints.ControlTipText = lastRow & " data points"
    AmplitudeRange.Caption = Application.WorksheetFunction.Min(ws.Range("B1:B" & lastRow)) & " to " & Application.WorksheetFunction.Max(ws.Range("B1:B" & lastRow)) & " dBm"
    AmplitudeRange.ControlTipText = Application.WorksheetFunction.Min(ws.Range("B1:B" & lastRow)) & " to " & Application.WorksheetFunction.Max(ws.Range("B1:B" & lastRow)) & " dBm"
    FrequencySpan.Caption = Application.WorksheetFunction.Min(ws.Range("A1:A" & lastRow)) & " to " & Application.WorksheetFunction.Max(ws.Range("A1:A" & lastRow)) & " megahertz"
    FrequencySpan.ControlTipText = Application.WorksheetFunction.Min(ws.Range("A1:A" & lastRow)) & " to " & Application.WorksheetFunction.Max(ws.Range("A1:A" & lastRow)) & " megahertz"
    Speed.Caption = playSpeed & " milliseconds per point speed"
    Speed.ControlTipText = playSpeed & " milliseconds per point speed"
  
    UpdateReadouts
  
    HalfSpeed.Caption = "Half Speed" & vbCrLf & vbCrLf & "Key Alt+7"
    SlowDown1ms.Caption = "Go Slower by" & vbCrLf & "0.5 millisecond" & vbCrLf & "per point" & vbCrLf & vbCrLf & "Key Alt+8"
    SpeedUp1ms.Caption = "Go Faster by" & vbCrLf & "0.5 millisecond" & vbCrLf & "per point" & vbCrLf & vbCrLf & "Key Alt+9"
    DoubleSpeed.Caption = "Double Speed" & vbCrLf & vbCrLf & "Key Alt+0"
    PlayBackward.Caption = "Play Backward" & vbCrLf & vbCrLf & "Key Alt+b"
    Pause.Caption = "Pause" & vbCrLf & vbCrLf & "Key Alt+p"
    PlayForward.Caption = "Play Forward" & vbCrLf & vbCrLf & "Key Alt+f"
    ZoomLoop.Caption = "Zoom Loop is Off" & vbCrLf & vbCrLf & "Key Alt+z"
    ZoomLoop.ControlTipText = "Zoom Loop is Off"
  
    SkipBackward500Points.Caption = "Skip Backward" & vbCrLf & "500 points" & vbCrLf & vbCrLf & "Key Alt+h"
    SkipBackward1Point.Caption = "Skip Backward" & vbCrLf & "1 point" & vbCrLf & vbCrLf & "Key Alt+j"
    SkipForward1Point.Caption = "Skip Forward" & vbCrLf & "1 point" & vbCrLf & vbCrLf & "Key Alt+k"
    SkipForward500Points.Caption = "Skip Forward" & vbCrLf & "500 points" & vbCrLf & vbCrLf & "Key Alt+l"
    SkipToFirstPoint.Caption = "Skip to" & vbCrLf & "first point" & vbCrLf & vbCrLf & "Key Alt+1"
    SkipToMidPoint.Caption = "Skip to" & vbCrLf & "middle point" & vbCrLf & vbCrLf & "Key Alt+2"
    SkipToEndPoint.Caption = "Skip to" & vbCrLf & "last point" & vbCrLf & vbCrLf & "Key Alt+3"
    StopClearAndImportNew.Caption = "Stop and" & vbCrLf & "clear data to" & vbCrLf & "import a new file" & vbCrLf & vbCrLf & "Key Alt+s"
  
    Sleep 300
  
    AllSoundsOff

    SendMIDIControlChange 91, 10
    SendMIDIControlChange 93, 0
    SetPitchBendSensitivity 1, 48, 0
  
    If stereoWide = True Then
        StereoPanWide
    Else
        StereoPanNarrow
    End If
  
    ScrubPadsEnable

    If lastRow <= 32767 Then
        ScrubPad1.Max = lastRow
        ScrubPad1.Value = Int(ControlPanel.ScrubPad1.Max / 2)
        ScrubPadsUpdate
    Else
        ScrubPad1.Max = 32767
        ScrubPad1.Value = Int(ControlPanel.ScrubPad1.Max / 2)
        ScrubPadsUpdate
    End If
  
    If scrbPdMPos = False Then
        quitPdMPos = True
        MouseLock.Caption = "ScrubPad MouseLock is Off" & vbCrLf & "Key Alt+m"
        MouseLock.ControlTipText = "ScrubPad MouseLock is Off"
    Else
        quitPdMPos = False
        MouseLock.Caption = "ScrubPad MouseLock is On" & vbCrLf & "Key Alt+m"
        MouseLock.ControlTipText = "ScrubPad MouseLock is On"
        MonoAscending
        If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer
    End If
  
End Sub

Private Sub StereoWidth_Click()

        If stereoWide = True Then
            StereoWidth.Caption = "Stereo is narrow" & vbCrLf & "Key Alt+w"
            StereoWidth.ControlTipText = "Stereo is narrow"
            stereoWide = False
            If isPausedBkwd = True And isPausedFwd = True Then StereoPanNarrow
        Else
            StereoWidth.Caption = "Stereo is wide" & vbCrLf & "Key Alt+w"
            StereoWidth.ControlTipText = "Stereo is wide"
            stereoWide = True
            If isPausedBkwd = True And isPausedFwd = True Then StereoPanWide
        End If
  
End Sub

Private Sub MouseLock_Click()

    If scrbPdMPos = False Then
        isPausedBkwd = True
        isPausedFwd = True
        scrbPdMPos = True
        quitPdMPos = False
        MouseLock.Caption = "ScrubPad MouseLock is On" & vbCrLf & "Key Alt+m"
        MouseLock.ControlTipText = "ScrubPad MouseLock is On"
        MonoAscending
        ScrubPadsEnable
        If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer
    Else
        isPausedBkwd = True
        isPausedFwd = True
        scrbPdMPos = False
        quitPdMPos = True
        MouseLock.Caption = "ScrubPad MouseLock is Off" & vbCrLf & "Key Alt+m"
        MouseLock.ControlTipText = "ScrubPad MouseLock is Off"
        MonoDescending
    End If

End Sub

Private Sub HelpReadMe_Click()

    isPausedBkwd = True
    isPausedFwd = True
    scrbPdMPos = False
    quitPdMPos = True
    MouseLock.Caption = "ScrubPad MouseLock is Off" & vbCrLf & "Key Alt+m"
    MouseLock.ControlTipText = "ScrubPad MouseLock is Off"
    MonoDescending
  
    Sleep 200

    HelpFileNotepad
    Beeper

End Sub

Private Sub ProgressBar_Change()

    If zmLp = True Then
        If isPausedBkwd = True And isPausedFwd = True Then
          
            currentRow = ProgressBar.Value
          
            If zoomPreviousRow < currentRow And currentRow = zoomLastRow Then
                ProgressBar.Value = zoomFirstRow
                currentRow = zoomFirstRow
            Else
                If zoomPreviousRow > currentRow And currentRow = zoomFirstRow Then
                    ProgressBar.Value = zoomLastRow
                    currentRow = zoomLastRow
                End If
            End If
          
            zoomPreviousRow = currentRow
          
            CalcMIDIPan
            SendMIDIControlChange 10, panMSB ' CC10 (MSB)
            SendMIDIControlChange 42, panLSB ' CC42 (LSB)
            SendMIDIPitchBend 1, pitchBendValue ' Channel 1
            UpdateReadouts
        End If
    Else
        If isPausedBkwd = True And isPausedFwd = True Then
      
            currentRow = ProgressBar.Value
          
            If previousRow < currentRow And currentRow = lastRow Then
                ProgressBar.Value = 1
                currentRow = 1
            Else
                If previousRow > currentRow And currentRow = 1 Then
                    ProgressBar.Value = lastRow
                    currentRow = lastRow
                End If
            End If
          
            previousRow = currentRow
          
            CalcMIDIPan
            SendMIDIControlChange 10, panMSB ' CC10 (MSB)
            SendMIDIControlChange 42, panLSB ' CC42 (LSB)
            SendMIDIPitchBend 1, pitchBendValue ' Channel 1
            UpdateReadouts
        End If
    End If
  
End Sub
Private Sub ProgressBar_Scroll()

    If zmLp = True Then
        If isPausedBkwd = True And isPausedFwd = True Then
          
            currentRow = ProgressBar.Value
          
            If zoomPreviousRow < currentRow And currentRow = zoomLastRow Then
                ProgressBar.Value = zoomFirstRow
                currentRow = zoomFirstRow
            Else
                If zoomPreviousRow > currentRow And currentRow = zoomFirstRow Then
                    ProgressBar.Value = zoomLastRow
                    currentRow = zoomLastRow
                End If
            End If
          
            zoomPreviousRow = currentRow
          
            CalcMIDIPan
            SendMIDIControlChange 10, panMSB ' CC10 (MSB)
            SendMIDIControlChange 42, panLSB ' CC42 (LSB)
            SendMIDIPitchBend 1, pitchBendValue ' Channel 1
            UpdateReadouts
        End If
    Else
        If isPausedBkwd = True And isPausedFwd = True Then
      
            currentRow = ProgressBar.Value
          
            If previousRow < currentRow And currentRow = lastRow Then
                ProgressBar.Value = 1
                currentRow = 1
            Else
                If previousRow > currentRow And currentRow = 1 Then
                    ProgressBar.Value = lastRow
                    currentRow = lastRow
                End If
            End If
          
            previousRow = currentRow
          
            CalcMIDIPan
            SendMIDIControlChange 10, panMSB ' CC10 (MSB)
            SendMIDIControlChange 42, panLSB ' CC42 (LSB)
            SendMIDIPitchBend 1, pitchBendValue ' Channel 1
            UpdateReadouts
        End If
    End If
  
End Sub

Private Sub ScrubPad1_Scroll()

    If isPausedBkwd = True And isPausedFwd = True Then
        TimerReset
        Timer2sec
      
        If noteIsOn = False Then
            SendMIDINoteOn 60
        End If
      
        ProgressBar.Value = ProgressBar.Value + ScrubPad1.Value - Int(ScrubPad1.Max / 2)
        UpdateReadouts
        ScrubPadsEnable
        ScrubPad1.Value = Int(ScrubPad1.Max / 2)
    End If
  
End Sub

Private Sub SlowDown1ms_Click()

    If playSpeed + 0.5 <= 500 Then
        playSpeed = playSpeed + 0.5
    Else
        playSpeed = 500
    End If
  
    Speed.Caption = playSpeed & " milliseconds per point speed"
    Speed.ControlTipText = playSpeed & " milliseconds per point speed"
    If isPausedBkwd = True And isPausedFwd = True Then PlayCurrent
  
End Sub

Private Sub HalfSpeed_Click()

    If Int((playSpeed * 2) * 2 + 0.5) / 2 <= 500 Then
        playSpeed = Int((playSpeed * 2) * 2 + 0.5) / 2
    Else
        playSpeed = 500
    End If
  
    Speed.Caption = playSpeed & " milliseconds per point speed"
    Speed.ControlTipText = playSpeed & " milliseconds per point speed"
    If isPausedBkwd = True And isPausedFwd = True Then PlayCurrent
  
End Sub

Private Sub DoubleSpeed_Click()

    If Int(playSpeed + 0.5) / 2 >= 1 Then
        playSpeed = Int(playSpeed + 0.5) / 2
    Else
        playSpeed = 0.5
    End If
  
    Speed.Caption = playSpeed & " milliseconds per point speed"
    Speed.ControlTipText = playSpeed & " milliseconds per point speed"
    If isPausedBkwd = True And isPausedFwd = True Then PlayCurrent
      
End Sub

Private Sub SpeedUp1ms_Click()

    If playSpeed >= 1 Then
        playSpeed = playSpeed - 0.5
    Else
        playSpeed = 0.5
    End If
  
    Speed.Caption = playSpeed & " milliseconds per point speed"
    Speed.ControlTipText = playSpeed & " milliseconds per point speed"
    If isPausedBkwd = True And isPausedFwd = True Then PlayCurrent
      
End Sub

Private Sub SkipBackward500Points_Click()

    If zmLp = False Then
        If currentRow > 501 Then
            previousRow = 0
            currentRow = currentRow - 500
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = currentRow + 1
        Else
            previousRow = 0
            currentRow = 1
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = 2
        End If
    End If
  

    If zmLp = True Then
        If currentRow > zoomFirstRow + 500 Then
            zoomPreviousRow = zoomFirstRow - 1
            currentRow = currentRow - 500
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow + 1
        Else
            zoomPreviousRow = zoomFirstRow - 1
            currentRow = zoomFirstRow
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow + 1
        End If
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing

End Sub

Private Sub SkipBackward1Point_Click()
      
    If zmLp = False Then
        If currentRow > 1 Then
            previousRow = 0
            currentRow = currentRow - 1
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = currentRow + 1
        End If
    End If
  
      
    If zmLp = True Then
        If currentRow > zoomFirstRow Then
            zoomPreviousRow = zoomFirstRow - 1
            currentRow = currentRow - 1
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow + 1
        End If
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
  
End Sub

Private Sub SkipForward1Point_Click()
  
    If zmLp = False Then
        If currentRow < lastRow Then
            previousRow = lastRow + 1
            currentRow = currentRow + 1
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = currentRow - 1
        End If
    End If
  
    If zmLp = True Then
        If currentRow < zoomLastRow Then
            zoomPreviousRow = zoomLastRow + 1
            currentRow = currentRow + 1
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow - 1
        End If
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
  
End Sub

Private Sub SkipForward500Points_Click()

    If zmLp = False Then
        If currentRow <= lastRow - 500 Then
            previousRow = lastRow + 1
            currentRow = currentRow + 500
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = currentRow - 1
        Else
            previousRow = lastRow + 1
            currentRow = lastRow
            ProgressBar.Value = currentRow
            UpdateReadouts
            previousRow = currentRow - 1
        End If
    End If
  
    If zmLp = True Then
        If currentRow <= zoomLastRow - 500 Then
            zoomPreviousRow = zoomLastRow + 1
            currentRow = currentRow + 500
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow - 1
        Else
            zoomPreviousRow = zoomLastRow + 1
            currentRow = zoomLastRow
            ProgressBar.Value = currentRow
            UpdateReadouts
            zoomPreviousRow = currentRow - 1
        End If
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
  
End Sub

Private Sub PlayBackward_Click()

    AllNotesOff
    stopPlayback = False
  
    If isPausedBkwd = False Then
        isPausedBkwd = True
            quitPdMPos = False
        ProgressBar.Value = currentRow
        UpdateReadouts
        ScrubPadsEnable
        If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer
    Else
        isPausedFwd = True
        isPausedBkwd = False
        quitPdMPos = True
        ScrubPadsDisable
        BackwardPlay
        ProgressBar.Value = currentRow
        UpdateReadouts
    End If
  
End Sub

Private Sub Pause_Click()

    AllNotesOff
    quitPdMPos = False
    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
    isPausedBkwd = True
    isPausedFwd = True
    ProgressBar.Value = currentRow
    UpdateReadouts
    ScrubPadsEnable
    If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer
  
End Sub

Private Sub PlayForward_Click()

    AllNotesOff
    stopPlayback = False
  
    If isPausedFwd = False Then
        isPausedFwd = True
        quitPdMPos = False
        ProgressBar.Value = currentRow
        UpdateReadouts
        ScrubPadsEnable
        If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer
    Else
        isPausedBkwd = True
        isPausedFwd = False
        quitPdMPos = True
        ScrubPadsDisable
        ForwardPlay
        ProgressBar.Value = currentRow
        UpdateReadouts
    End If
  
End Sub

Private Sub ZoomLoop_Click()

    If zmLp = True Then
        isPausedBkwd = True
        isPausedFwd = True
        zmLp = False
      
        currentRow = previousRow
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
      
        ProgressBar.Min = 1
        ProgressBar.Max = lastRow
      
        If stereoWide = True Then
            StereoPanWide
        Else
            StereoPanNarrow
        End If
      
        playSpeed = previousSpeed
      
        Speed.Caption = playSpeed & " milliseconds per point speed"
        Speed.ControlTipText = playSpeed & " milliseconds per point speed"
        UpdateReadouts
      
        ZoomLoop.Caption = "Zoom Loop is Off" & vbCrLf & vbCrLf & "Key Alt+z"
        ZoomLoop.ControlTipText = "Zoom Loop is Off"
    Else
        isPausedBkwd = True
        isPausedFwd = True
        quitPdMPos = True
      
        previousRow = currentRow
        previousSpeed = playSpeed
      
        SetZoomStart
      
        If StrPtr(zoomLowInput) = 0 Then
            GoTo QuitZmLp
        ElseIf zoomLowInput = vbNullString Then
            GoTo QuitZmLp
        End If
          
        SetZoomEnd
      
        If StrPtr(zoomHighInput) = 0 Then
            GoTo QuitZmLp
        ElseIf zoomHighInput = vbNullString Then
            GoTo QuitZmLp
        End If
      
        zmLp = True
      
        currentRow = zoomFirstRow
        lastRow = zoomLastRow
        UpdateReadouts
          
        ProgressBar.Min = zoomFirstRow
        ProgressBar.Max = zoomLastRow
      
        ZoomLoop.Caption = "Zoom Loop is On" & vbCrLf & vbCrLf & Format(ws.Cells(currentRow, "A").Value, "#000.0000") & vbCrLf & " to " & vbCrLf & Format(ws.Cells(zoomLastRow, "A").Value, "#000.0000") & vbCrLf & vbCrLf & "Key Alt+z"
        ZoomLoop.ControlTipText = "Zoom Loop is On " & Format(ws.Cells(currentRow, "A").Value, "#000.0000") & " to " & Format(ws.Cells(zoomLastRow, 1).Value, "#000.0000")
      
      
        If stereoWide = True Then
            StereoPanWide
        Else
            StereoPanNarrow
        End If
      
        zoomPreviousRow = zoomFirstRow + 1
      
        If playSpeed * (zoomLastRow - zoomFirstRow) < 2500 Then playSpeed = Int(2500 / (zoomLastRow - zoomFirstRow))
      
        Speed.Caption = playSpeed & " milliseconds per point speed"
        Speed.ControlTipText = playSpeed & " milliseconds per point speed"
      
    End If

QuitZmLp:
      
    ScrubPadsEnable
      
    quitPdMPos = False
      
    If scrbPdMPos = True And msTmrRunning = False Then ScrbMouseTimer

End Sub

Private Sub SkipToFirstPoint_Click()
  
    If zmLp = False Then
        previousRow = 0
        currentRow = 1
        ProgressBar.Value = 1
        previousRow = currentRow + 1
        UpdateReadouts
    Else
        zoomPreviousRow = zoomFirstRow - 1
        currentRow = zoomFirstRow
        ProgressBar.Value = zoomFirstRow
        zoomPreviousRow = currentRow + 1
        UpdateReadouts
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
  
End Sub

Private Sub SkipToMidPoint_Click()
  
    If zmLp = False Then
        currentRow = Int(lastRow / 2)
        ProgressBar.Value = Int(lastRow / 2)
        UpdateReadouts
    Else
        currentRow = zoomFirstRow + Int((zoomLastRow - zoomFirstRow) / 2)
        ProgressBar.Value = zoomFirstRow + Int((zoomLastRow - zoomFirstRow) / 2)
        UpdateReadouts
    End If

    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
      
End Sub

Private Sub SkipToEndPoint_Click()

    If zmLp = False Then
        previousRow = lastRow + 1
        currentRow = lastRow
        ProgressBar.Value = lastRow
        previousRow = lastRow - 1
        UpdateReadouts
    Else
        zoomPreviousRow = zoomLastRow + 1
        currentRow = zoomLastRow
        ProgressBar.Value = zoomLastRow
        zoomPreviousRow = zoomLastRow - 1
        UpdateReadouts
    End If
  
    If isPausedBkwd = True And isPausedFwd = True Then PlayDing
  
End Sub

Private Sub StopClearAndImportNew_Click()

    ScrubPadsDisable
    ProgressBar.Enabled = False

    AllSoundsOff
  
    cntrlPnl = False
    quitPdMPos = True
    isPausedBkwd = True
    isPausedFwd = True
    stopPlayback = True
    firstImport = False
    zmLp = False
  
    'TimerReset
  
    ' Clean up and unload
    Call StrikeIconTskbar(Me)
    CleanupMIDI
    Application.DisplayAlerts = False
    On Error Resume Next
    Unload Me
    Start_Over
  
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    ScrubPadsDisable
    ProgressBar.Enabled = False
    AllSoundsOff
    cntrlPnl = False
    quitPdMPos = True
    isPausedBkwd = True
    isPausedFwd = True
    stopPlayback = True
    firstImport = False
    zmLp = False
    previousSpeed = playSpeed
    CleanupMIDI
    Unload Me
      
    If CloseMode = vbFormControlMenu Then
        Call StrikeIconTskbar(Me)
        Application.Visible = True
        ThisWorkbook.Saved = True
        Unload Me
        Beeper
        CleanupMIDI
        Application.Quit
    End If
      
End Sub

FYI, the stuff I hid for privacy should not at all affect key commands. And the MouseLock calls do not involve any clicks, but rather only hover its pointer over a necessary area.
 
Last edited by a moderator:

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
If you literally mean the userform has the focus I think you are out of luck. I have not been able to get a form itself to recognize many events (at least not when modeless). Maybe it behaves similar to Access forms in that they cannot take the focus when the form contains controls. That being said, you'd think that the alt key alone when no control on the form has the focus would therefore be inconsequential. So are you sure this happens when no form control has the focus, but perhaps the form does? Or something else does? I'm thinking that if that is truly the case, then you need to use an event for a control, not the form. KeyDown for a textbox should be able to detect keycode 18 (alt). That event does not have a cancel parameter, so not sure what you could do with the info as that would depend on how your users are using the application.
 
Upvote 0
Micron said:
If you literally mean the userform has the focus I think you are out of luck. I have not been able to get a form itself to recognize many events (at least not when modeless). Maybe it behaves similar to Access forms in that they cannot take the focus when the form contains controls. That being said, you'd think that the alt key alone when no control on the form has the focus would therefore be inconsequential. So are you sure this happens when no form control has the focus, but perhaps the form does? Or something else does? I'm thinking that if that is truly the case, then you need to use an event for a control, not the form. KeyDown for a textbox should be able to detect keycode 18 (alt). That event does not have a cancel parameter, so not sure what you could do with the info as that would depend on how your users are using the application.
Click to expand...

I wrote, "When the main UserForm named ControlPanel has focus, Alt+ accelerator keys work fine. But tapping or holding and releasing Alt without an accelerator key pauses execution and makes ControlPanel unresponsive until Alt is tapped again."

I didn't specify in my OP, but when ControlPanel does not have the focus, tapping Alt does not pause execution. I know this because under certain conditions the code intentionally continues to play sounds via MIDI commands that it sends to a synthesizer, and when the user clicks anywhere outside of ControlPanel and takes focus away from it, the sounds continue to play and tapping Alt has no affect.
 
Upvote 0
glasstronomic said:
I wrote, "When the main UserForm named ControlPanel has focus, Alt+ accelerator keys work fine. But tapping or holding and releasing Alt without an accelerator key pauses execution and makes ControlPanel unresponsive until Alt is tapped again."

I didn't specify in my OP, but when ControlPanel does not have the focus, tapping Alt does not pause execution. I know this because under certain conditions the code intentionally continues to play sounds via MIDI commands that it sends to a synthesizer, and when the user clicks anywhere outside of ControlPanel and takes focus away from it, the sounds continue to play and tapping Alt has no affect.
Click to expand...

I should also mention that the Excel application is always hidden during execution.
 
Upvote 0
That reply seems indignant to me. Seeing as how you are sure that a userform can take the focus when there is no such property or method listed, and checking as in
?Me.GotFocus or anything similar will produce an error, then I can't help. Good luck.
1738015877873.png

learn.microsoft.com

UserForm object

Office VBA reference topic
learn.microsoft.com
 
Upvote 0
I don't mean to sound indignant. I didn't understand but now realize that it's not the form that has focus, but rather if any control in the form having focus that causes trouble.
 
Upvote 0
Your code is too overwhelming to follow ... Are you able to reproduce the issue you are experimenting with a simple userform and some minimum code and post it here so we can take a look ?
 
Upvote 0
Thank you, Jaafar. I have learned from your many amazing posts here and I am grateful for them all.

Here is a simple version that suffers the same Alt key behavior. It's Windows only, and should produce piano sounds on the default system MIDI device. RunToTestForAltKeyWeirdness is the starting sub.


UserForm1

VBA Code: 
Private Sub CommandButton1_Click()

MIDIloopOn

End Sub

Private Sub CommandButton2_Click()

MIDIloopOff

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    AllNotesOff
    Application.Visible = True
    Unload Me
    CleanupMIDI
    Application.Quit
        
    If CloseMode = vbFormControlMenu Then
        AllNotesOff
        Application.Visible = True
        Unload Me
        CleanupMIDI
        Application.Quit
    End If
        
End Sub

Module1

VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
        Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As Long) As Long
        Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
        Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
    #Else
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
        Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
        Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
        Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
    #End If
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
    Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
#End If

Public hMidiOut As LongPtr
Public panMSB As Integer
Public panLSB As Integer
Public pitchLSB As Integer
Public pitchMSB As Integer
Public noteIsOn As Boolean
Public pitchBendValue As Long
Public toneFreq As Double

Sub RunToTestForAltKeyWeirdness()

UserForm1.Show vbModeless

End Sub

Sub OpenMIDI()
    Dim result As Long
    
    If hMidiOut = 0 Then
        result = midiOutOpen(hMidiOut, 0, 0, 0, 0)
        If result <> 0 Then
            MsgBox "Failed to open MIDI output device.", vbCritical
            End
        End If
    End If
    
End Sub

Sub CleanupMIDI()
    
    If hMidiOut <> 0 Then
        midiOutClose hMidiOut
        hMidiOut = 0
    End If
    
End Sub

Sub SendMIDIControlChange(controllerNumber As Integer, controllerValue As Integer)
    Dim midiMessage As Long
    Dim result As Long
    
    midiMessage = &HB0 Or (controllerNumber * &H100) Or (controllerValue * &H10000)
    result = midiOutShortMsg(hMidiOut, midiMessage)
    
End Sub

Sub SendMIDINoteOn(note As Integer)
    Dim midiMessage As Long
    Dim result As Long
    
    midiMessage = &H90 Or (note * &H100) Or (&H7F * &H10000)
    result = midiOutShortMsg(hMidiOut, midiMessage)
    
End Sub

Sub AllNotesOff()

    SendMIDIControlChange 123, 0

End Sub

Sub MIDIloopOn()

    noteIsOn = True
    
    OpenMIDI

Do While noteIsOn = True
    
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 48
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 60
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 72
    Sleep 500
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 31
    SendMIDIControlChange 42, 95
    SendMIDINoteOn 42
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 95
    SendMIDIControlChange 42, 32
    SendMIDINoteOn 42
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 31
    SendMIDIControlChange 42, 95
    SendMIDINoteOn 42
    Sleep 500
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 72
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 60
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 48
    Sleep 500
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 0
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 36
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 127
    SendMIDIControlChange 42, 127
    SendMIDINoteOn 36
    Sleep 500
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 0
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 36
    Sleep 500
    DoEvents
    AllNotesOff
    
    If noteIsOn = False Then Exit Do
    
Loop
    
    
End Sub

Sub MIDIloopOff()

    noteIsOn = False
    
    CleanupMIDI

End Sub
 
Upvote 0
It seems that the pause happens not at Alt KeyDown but rather occurs at Alt KeyUp if any other key does not follow the KeyDown. FWIW, I wonder if there's a way to force that when any control is in focus, KeyDown on key 18 is allowed but KeyUp is somehow suppressed until after some other key is pressed? Or maybe this would cause other problems.
 
Upvote 0
I may have this nailed, so please stand by. It seems to work fine with command buttons, so far, but I need to fully integrate it with my forms and test with screen reader apps before marking this as a solution. Even though Excel vba can't focus on labels, I think that screen readers somehow force that, so I need to try it. That could take awhile.

VBA Code: 
Private Sub CommandButton1_Click()

MIDIloopOn

End Sub

Private Sub CommandButton2_Click()

MIDIloopOff

End Sub

Private Sub CommandButton1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 18 Then
    KeyCode = 0
End If

End Sub

Private Sub CommandButton2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 18 Then
    KeyCode = 0
End If

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    AllNotesOff
    Application.Visible = True
    Unload Me
    CleanupMIDI
    Application.Quit
        
    If CloseMode = vbFormControlMenu Then
        AllNotesOff
        Application.Visible = True
        Unload Me
        CleanupMIDI
        Application.Quit
    End If
        
End Sub

VBA Code: 
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
        Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As LongPtr, ByVal uDeviceID As Long, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As Long) As Long
        Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As LongPtr, ByVal dwMsg As Long) As Long
        Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As LongPtr) As Long
    #Else
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
        Private Declare PtrSafe Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
        Private Declare PtrSafe Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
        Private Declare PtrSafe Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
    #End If
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function midiOutOpen Lib "winmm.dll" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    Private Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As Long
    Private Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As Long
#End If

Public hMidiOut As LongPtr
Public panMSB As Integer
Public panLSB As Integer
Public pitchLSB As Integer
Public pitchMSB As Integer
Public noteIsOn As Boolean
Public pitchBendValue As Long
Public toneFreq As Double

Sub RunToTestForAltKeyWeirdness()

UserForm1.Show vbModeless

End Sub

Sub OpenMIDI()
    Dim result As Long
    
    If hMidiOut = 0 Then
        result = midiOutOpen(hMidiOut, 0, 0, 0, 0)
        If result <> 0 Then
            MsgBox "Failed to open MIDI output device.", vbCritical
            End
        End If
    End If
    
End Sub

Sub CleanupMIDI()
    
    If hMidiOut <> 0 Then
        midiOutClose hMidiOut
        hMidiOut = 0
    End If
    
End Sub

Sub SendMIDIControlChange(controllerNumber As Integer, controllerValue As Integer)
    Dim midiMessage As Long
    Dim result As Long
    
    midiMessage = &HB0 Or (controllerNumber * &H100) Or (controllerValue * &H10000)
    result = midiOutShortMsg(hMidiOut, midiMessage)
    
End Sub

Sub SendMIDINoteOn(note As Integer)
    Dim midiMessage As Long
    Dim result As Long
    
    midiMessage = &H90 Or (note * &H100) Or (&H7F * &H10000)
    result = midiOutShortMsg(hMidiOut, midiMessage)
    
End Sub

Sub AllNotesOff()

    SendMIDIControlChange 123, 0

End Sub

Sub MIDIloopOn()

    noteIsOn = True
    
    OpenMIDI

Do While noteIsOn = True
    
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 48
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 60
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 72
    Sleep 200
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 31
    SendMIDIControlChange 42, 95
    SendMIDINoteOn 42
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 95
    SendMIDIControlChange 42, 32
    SendMIDINoteOn 42
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 31
    SendMIDIControlChange 42, 95
    SendMIDINoteOn 42
    Sleep 200
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 72
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 60
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 64
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 48
    Sleep 200
    DoEvents
    AllNotesOff
    
    SendMIDIControlChange 10, 0
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 36
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 127
    SendMIDIControlChange 42, 127
    SendMIDINoteOn 36
    Sleep 200
    DoEvents
    AllNotesOff
    SendMIDIControlChange 10, 0
    SendMIDIControlChange 42, 0
    SendMIDINoteOn 36
    Sleep 200
    DoEvents
    AllNotesOff
    
    If noteIsOn = False Then Exit Do
    
Loop
    
    
End Sub

Sub MIDIloopOff()

    noteIsOn = False

    AllNotesOff
    
    CleanupMIDI

End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

D
  • Solved
Error 1004
2
Replies
18
Views
543
dmt32
D
I
  • Question Question
Apply delay before running code
Replies
8
Views
285
ipbr21054
I
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
397
Alex Blakenburg
A
I
  • Question Question
Receive Automation error when running code & values added to sheet twice
2
Replies
13
Views
545
NoSparks
N
C
  • Question Question
Finding the problem with the code that gives the message "The picture is too large and will be truncated" ...
2
Replies
14
Views
284
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,226,528
Messages
6,191,580
Members
453,665
Latest member
WaterWorks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top