Sub PlayMIDI(iVoiceNum As Integer, vNoteNum As Variant, Optional iVolume As Integer = 127)
Dim i As Integer, vArr As Variant, iFound As Long
If hMidiOut = 0 Then Exit Sub ' Kein Handle=>raus
If iVoiceNum > 0 Then _
midiOutShortMsg hMidiOut, (256 * iVoiceNum) + 192 ' Instrument wählen
vArr = Split(vNoteNum, ",") ' Noten zusamenstellen
On Error Resume Next
For i = 0 To UBound(vArr)
If Val(vArr(i)) = 0 Then
With ThisWorkbook.Sheets("Midi")
iFound = 0
iFound = WorksheetFunction.Match(vArr(i), .Columns(15), 0)
If iFound > 0 Then
vArr(i) = .Cells(iFound, 14).Value
End If
End With
End If
midiOutShortMsg hMidiOut, RGB(144 + 10, vArr(i), iVolume) '144 = h90
Next i
DoEvents
End Sub
On Error Resume Next
With ThisWorkbook.Sheets("Midi")
iFound = 0
iFound = WorksheetFunction.Match(vArr(i), .Columns(15), 0)
If iFound > 0 Then
vArr(i) = .Cells(iFound, 14).Value
End If
End With
(iZeileMel, 3)
Code:
Sub BegleitungProc()
KillTimer 0&, hTimerBeg: hTimerBeg = 0 ' Begleitungs-Timer löschen
With ThisWorkbook.Sheets("Midi")
Do
iZeileBeg = iZeileBeg + 1
If iZeileBeg > .Cells(.Rows.Count, "F").End(xlUp).Row Then
If hTimerMel = 0 Then midiOutClose hMidiOut: hMidiOut = 0
Exit Sub
End If
If Val(.Cells(iZeileBeg, 8).Value) > 0 Then Exit Do
Loop
PlayMIDI .Cells(iZeileBeg, 6).Value, .Cells(iZeileBeg, 7).Value, .Cells(iZeileBeg, 9).Value
If cTimerBeg = 0 Then cTimerBeg = (Timer * 1000)
cTimerBeg = cTimerBeg + .Cells(iZeileBeg, 8).Value
hTimerBeg = SetTimer(0&, 0&, cTimerBeg - (Timer * 1000), AddressOf BegleitungProc)
End With
End Sub