test2 PIANO

test2  PIANO 

'MIDI API

Private Declare PtrSafe Function midiOutGetNumDevs Lib "winmm" () As Integer

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

Dim Handle As LongPtr

'Sleep API

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

'SheetSelectionChange event

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Call PIANO_hit_key

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.ScreenUpdating = False:

Application.CommandBars("Cell").Reset '初期化

End Sub

'Cell CommandBer

Private Sub Workbook_Open()

Application.CommandBars("Cell").Reset '初期化

Set Ctrl1 = Application.CommandBars("Cell").Controls.Add: Ctrl1.Caption = "●PIANO　音　テスト": Ctrl1.OnAction = "PIANO_key"

End Sub

'PIANO keyNumber select action

Private Sub PIANO_hit_key()

Dim note As Variant

Dim Ret As Long

Dim i As Long

Dim Msg As Long

Dim BaseMsg1 As Long

note = ActiveCell.Value

note_p = InStr(note, vbLf):

Select Case note_p: Case Is > 0: note = Val(Mid(note, note_p + 1)): End Select

Select Case note

Case Is > 111: Exit Sub: Case Is < 21: Exit Sub: Case Is > 20:

Ret = midiOutGetNumDevs

Select Case Ret: Case 0: MsgBox "MIDI音源が無いため利用できません。": Exit Sub:

Case Else: Ret = midiOutOpen(Handle, -1, 0, 0, 0)

End Select

Case Else: Exit Sub:

End Select

velocity = 20 ' 音の強さ

channel = 1 '

Msg = velocity * &H10000 + note * &H100 + &H90 + channel:

Call midiOutShortMsg(Handle, Msg):

Sleep (200)

velocity = 127 ' 音の強さ

Msg = velocity * &H10000 + note * &H100 + &H90 + channel:

Call midiOutShortMsg(Handle, Msg):

Sleep (900)

Msg = velocity * &H10000 + note * &H100 + &H80 + channel:

Call midiOutShortMsg(Handle, Msg):

Ret = midiOutClose(Handle)

End Sub