24

私はこれらの1つを持っています（ソース：netdna-cdn.com）nanoKontrolの

そして、Excelフォームコントロールのスクロールバーの1つと同じように、そのスライダーを使用して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
4

3 に答える 3

2

問題はおそらくMsgBox次のとおりです。

  • MIDI イベントはコールバックを使用するため、おそらく別のスレッドから実行されます。VBA は本質的にシングルスレッドです (例: VBA のマルチスレッドを参照)。そのため、別のスレッドからモーダル ダイアログを表示しようとすると、問題が発生する可能性があります (未定義の動作、クラッシュ、その他...)。
  • MIDI は通常、大量のイベントをトリガーします (スライダーまたはノブのごくわずかな動きがイベントをトリガーします)。各イベントでダイアログを表示する ([OK] をクリックする必要がある) と、問題が発生する可能性があります。

テストのために、値がイミディエイト ウィンドウに出力されるように置き換えCall MsgBox(dw1)てみてください。これにより、はるかに安定するはずです。Debug.Print dw1いくつかの単純なアクション (セルの値を更新する、ウィンドウをスクロールするなど) を実行しようとしている場合、次のイベントの前に各呼び出しが完了する限り、それを回避できる場合があります。MidiIn_Event

はるかに複雑ですが安定したソリューションは、データ ポイントをイベント ハンドラーのキューにプッシュし、VBA で繰り返しタイマーを使用してキューから項目をポップし、VBA スレッドで何らかのアクションを実行することです。

于 2013-01-24T23:33:40.043 に答える
1

これはとてもクールです：D

しかし、上記のメッセージボックスはそれを殺しますが、メッセージボックスを削除してもそれほど役に立たないでしょう。vba-> excelは瞬時に実行されないため、トラフィックの量を最小限に抑えてExcelも使用する必要があります。

すっごく解決策は

ブック開始マクロ

    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
于 2013-01-25T14:07:10.570 に答える
1

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 キーを押すとスクリプトがクラッシュする理由を知りたいです。

グローバル変数を必要に応じて調整するだけです。

私が助けてくれることを願っています。

于 2019-12-29T08:51:32.013 に答える