Question

我有其中一个nanoKontrol's http://mustech.jpsystemsinc.netdna-cdn.com/wp-content/uploads/2008/12/kontrol.gif 并希望使用它上的滑块来控制Excel，就像一个Excel表单控件滚动条。

我设法为VBA修改了this code，但它非常不稳定。任何人都可以帮助我稳定它吗？我认为函数MidiIn_Event可能会崩溃，如果它没有足够快地返回，但我可能是错的。

提前致谢。

Public Const CALLBACK_FUNCTION = &H30000
Public Declare Function midiInOpen Lib "winmm.dll" 
        (lphMidiIn As Long, 
        ByVal uDeviceID As Long, ByVal dwCallback As Any, 
        ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
Public Declare Function midiInClose Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInStart Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInStop Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Public Declare Function midiInReset Lib "winmm.dll" 
        (ByVal hMidiIn As Long) As Long
Private ri As Long

Public Sub StartMidiFunction()
    Dim lngInputIndex As Long
    lngInputIndex=0
    Call midiInOpen(ri, lngInputIndex, AddressOf MidiIn_Event, 
            0, CALLBACK_FUNCTION)
    Call midiInStart(ri)
End Function

Public Sub EndMidiRecieve()
    Call midiInReset(ri)
    Call midiInStop(ri)
    Call midiInClose(ri)
End Sub

Public Function MidiIn_Event(ByVal MidiInHandle As Long, 
        ByVal Message As Long, ByVal Instance As Long, 
        ByVal dw1 As Long, ByVal dw2 As Long) As Long

    'dw1 contains the midi code
    If dw1 > 255 Then 'Ignore time codes
        Call MsgBox(dw1)    'This part is unstable
    End If
End Function

Answer 1

问题可能是MsgBox：

由于MIDI事件使用回调，因此很可能是从另一个线程运行。 VBA本质上是单线程的（参见例如Multi-threading in VBA），因此尝试从另一个线程显示模式对话框可能会导致问题（未定义的行为，崩溃，其他任何事情......）
MIDI通常会触发大量事件（滑块或旋钮的微小移动会触发事件），因此移动一些显着数量的事物可能会导致数百个事件。在每个事件中显示一个对话框（需要OK点击）可能是个问题。

要进行测试，请尝试将Call MsgBox(dw1)替换为Debug.Print dw1，以便在立即窗口中打印这些值，这应该更加稳定。如果您尝试执行一些简单的操作（例如更新单元格中的值，滚动窗口），只要每次调用MidiIn_Event完成，可能就可以躲开它在下一次活动之前。

更复杂但更稳定的解决方案可能是将数据点推送到事件处理程序中的队列，并在VBA中使用重复计时器从队列中弹出项目并在VBA线程上执行某些操作。

Answer 2

这太酷了：D

但上面提到的消息框会将其删除，但删除消息框可能无济于事。您希望最大限度地减少流量的减少，因为vba-＆gt; excel不会是即时的。

Soooo解决方案将是

在工作簿启动宏

上

    Public lngMessage As String

    Private Sub Workbook_Open()
        alertTime = Now + TimeValue("00:00:01")
        Application.OnTime alertTime, "EventMacro"
    End Sub
    Sub EventMacro()
        ActiveSheet.Cells(1, 1).Value = lngMessage
        alertTime = Now + TimeValue("00:00:01")
    End Sub

    Public Function MidiIn_Event(ByVal MidiInHandle As Long, ByVal Message As Long, ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
        'dw1 contains the midi code
        If dw1 > 255 Then 'Ignore time codes
            lngMessage = dw1    'This part is now happy
        End If
    End Function

Answer 3

您需要一个通用函数来处理MidiIn_Event提供的数据，在我的示例中，该函数是runClock（）一个。

我这样做是为了能够使用状态栏来计数消息的键和时钟类型。

Option Explicit

Private Const CALLBACK_FUNCTION = &H30000

'MIDI Functions here: https://docs.microsoft.com/en-us/windows/win32/multimedia/midi-functions
#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
    'For MIDI device INPUT
    Private Declare PtrSafe Function midiInOpen Lib "winmm.dll" (lphMidiIn As LongPtr, ByVal uDeviceID As LongPtr, ByVal dwCallback As LongPtr, ByVal dwInstance As LongPtr, ByVal dwFlags As LongPtr) As Long
    Private Declare PtrSafe Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
    Private Declare PtrSafe Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As LongPtr) As Long
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function timeGetTime Lib "winmm.dll" () As Long
    'For MIDI device INPUT
    Private Declare Function midiInOpen Lib "winmm.dll" (lphMidiIn As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As Long
    Private Declare Function midiInClose Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStart Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInStop Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
    Private Declare Function midiInReset Lib "winmm.dll" (ByVal hMidiIn As Long) As Long
#End If

#If Win64 Then
    Private mlngCurDevice      As Long
    Private mlngHmidi          As LongPtr
#Else
    Private mlngCurDevice      As Long
    Private mlngHmidi          As Long
#End If

Private ClockTicks             As Integer
Private Notes                  As Integer
Private Looper                 As Long
Private LongMessage            As Long
Private actualTime             As Long

Public Sub runClock()

    'When canceled become able to close opened Input devices (For ESC press)
    On Error GoTo handleCancel
    Application.EnableCancelKey = xlErrorHandler

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        '.DisplayStatusBar = False
        '.EnableEvents = False
    End With

    mlngCurDevice = 8 'My Device is 8 but yours is 0
    Notes = 0
    Looper = 0

    'Open Input Device
    Call midiInOpen(mlngHmidi, mlngCurDevice, AddressOf MidiIn_Event, 0, CALLBACK_FUNCTION)

    'Ends only when Status is different from 0
    Do While Notes < 10
        'Reset Status count
        ClockTicks = 0

        'Begins lissinting the MIDI input
        Call midiInStart(mlngHmidi)

        'Loops until the right message is given <= 255 and > 0
        Do While ClockTicks < 1000 And Notes < 10
            'Sleep if needed
            Sleep 10
            Application.StatusBar = "Looper=" & Looper & " | Notes=" & Notes & " | ClockTicks=" & ClockTicks & " | Message=" & LongMessage
            Looper = Looper + 1
            'DoEvents enables ESC key
            If Abs(timeGetTime - actualTime) > 3000 Then
                DoEvents
                actualTime = timeGetTime
            End If
        Loop

        'Ends lisingting the MIDI input
        Call midiInReset(mlngHmidi)
        Call midiInStop(mlngHmidi)

    Loop

    'Closes Input device
    Do While midiInClose(mlngHmidi) <> 0
    Loop

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

    MsgBox "ENDED WITH SUCCESS", , "Message:"

    'Close all opened MIDI Inputs when canceled (ESC key pressed)
handleCancel:
        If Err.Number = 18 Then

            'Ends lisingting the MIDI input
            Call midiInReset(mlngHmidi)
            Call midiInStop(mlngHmidi)
            Do While midiInClose(mlngHmidi) <> 0
            Loop

            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With

            MsgBox "ENDED WITH SUCCESS", , "Message:"

        End If

End Sub

Private Function MidiIn_Event(ByVal mlngHmidi As Long, ByVal Message As Long, ByVal Instance As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

    'The value 963 is the MIM_DATA concerning regular MIDI messages
    If Message = 963 Then
        LongMessage = Message
        If dw1 > 255 Then
            Notes = Notes + 1
        Else
            ClockTicks = ClockTicks + 1
        End If
    End If

End Function

由于某些原因，当接收MIDI数据（例如时钟同步）时，按下ESC键时，问题就来了，尽管其他一切正常，但ESC键却多次使脚本崩溃。但是，如果在输入MIDI消息期间不使用ESC键，则不会出现此问题。

尽管如此，我仍然想知道为什么在接收时钟信号的同时按下ESC键会使脚本崩溃。

您只需要使全局变量适应您的需求即可。

希望我有帮助。

通过Midi控制器控制Excel

3 个答案: